!! Hadcas_40.f90 is a part of the PACIAE event generator.
!! Copyright (C) 2024 PACIAE Group.
!! PACIAE is licensed under the GNU GPL v2 or later, see LICENSE for details.
!! Open source: https://github.com/ArcsaberHep/PACIAE4
!! Author: Ben-Hao Sa, September 2000 - February 2025.

!> This is the program to deal with the hadron cascade (hadronic rescattering).

!!                                             By Ben-Hao at CIAE on 20/09/2000
!!                                  Last updated by An-Ke at UiO  on 03/02/2025


        subroutine hadcas( time_had )
!!      Deals with the hadron cascade (hadronic rescattering).
!
!       It was composed by Ben-Hao Sa on 20/09/2000.
!       Its input messages are in "sa1_h", which plays
!        the working block as well.
!       Its output messages are in "sa1_h".
        IMPLICIT DOUBLE PRECISION(A-H, O-Z)
        IMPLICIT INTEGER(I-N)
        LOGICAL IS_EXIST
        PARAMETER (KSZJ=300000,NSIZE=750000)
        common/sa1/kjp21,nonsa1,bp,iii,neve,nout,nosc
        common/sa1_h/nsa,non1,ksa(kszj,5),psa(kszj,5),vsa(kszj,5)
        common/sa1_h2/ ksa678(kszj,3),psa67(kszj,2)
        common/sa8_h/tau(kszj),ishp(kszj)
        common/sa9_h/kfmax,kfaco(100),numb(100)
        common/ctllist_h/nctl,noinel(2000),nctl0,noel
        common/ctllist_t/ lc(nsize,6), tc(nsize), tw(nsize)
        common/sa24/adj1(40),nnstop,non24,zstop
        common/para_h1/ para(100)
        COMMON/SA1_PY8/ i_mode, i_tune, KF_woDecay(100), &
               KF_proj, KF_targ, win, energy_B, psno, b_min, b_max
!       nctl: current total number of collision pairs in the collision time list
!       time_had: last collision time
!       icp: the icp-th collision pair
!       tcp: the collision time of the icp-th collision pair


!       Initialization.
        time_had = 0D0
        if( kjp21 == 0 ) return
        if( nsa < 2 ) return
        call sysini_h

!       Creates the initial collision time list.
        call ctlcre_h
        if( nctl <= 0 ) return

!       Administrates the hadron cascade.
        call scat_h( time_had )

!       Changes K0, K0bar to K0L and K0S. Kaon mixing.
        do i=1,nsa,1
            KS = ksa(i,1)
            KF = ksa(i,2)
            if( .NOT.IS_EXIST(KS,i_mode) ) cycle
            if( KF /= 311 .AND. KF /= -311 ) cycle
            if( PYR(1) < 0.5D0 )then
                ksa(i,2) = 130
            else
                ksa(i,2) = 310
            end if
        end do


        return
        end



!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
        subroutine sysini_h
!!      Gives initial values to the quantities needed in the hadron cascade.
        IMPLICIT DOUBLE PRECISION(A-H, O-Z)
        IMPLICIT INTEGER(I-N)
        LOGICAL IS_EXIST, INTO_HRS
        LOGICAL IS_ALICE_LONGLIVED
        PARAMETER (KSZJ=300000,NSIZE=750000)
        COMMON/PYCIDAT1/KFACOT(100),ISINELT(2000)
        COMMON/PYCIDAT2/KFMAXT,NONT2,PARAM(100)
        common/sa1_h/nsa,non1,ksa(kszj,5),psa(kszj,5),vsa(kszj,5)
        common/sa1_h2/ ksa678(kszj,3),psa67(kszj,2)
        common/sa8_h/tau(kszj),ishp(kszj)
        common/sa9_h/kfmax,kfaco(100),numb(100)
        common/sa10/csnn_p,cspin_p,cskn_p,cspipi_p,cspsn_p,cspsm_p, &
         rcsit_p,ifram_p,iabsb_p,iabsm_p,i_sigma_AQM_p,ajpsi_p,csspn_p, &
         csspm_p,csen_p
        common/sa10_h/csnn,cspin,cskn,cspipi,cspsn,cspsm,rcsit,ifram, &
         iabsb,iabsm,i_sigma_AQM,csspn,csspm
        common/sa20_h/t0,cspipiKK,dep,ddt,edipi,epin,ecsnn,ekn,ecspsn,ecspsm, &
         rnt,rnp,ecsspn,ecsspm
        common/sa25/i_inel_proc,i_time_shower,i_diquark,ipad25,para1_1,para1_2
        common/sa24/adj1(40),nnstop,non24,zstop
        common/syspar_h/pio
        common/count_h/isinel(2000)
        common/ctllist_h/nctl,noinel(2000),nctl0,noel
        common/ctllist_t/ lc(nsize,6), tc(nsize), tw(nsize)
!       For cross sections of hh collisions etc.
        common/para_h1/ para(100)
!       For the simulation control.
        COMMON/SA1_PY8/ i_mode, i_tune, KF_woDecay(100), &
               KF_proj, KF_targ, win, energy_B, psno, b_min, b_max
!       cspipi (fm^2): total cross section of pion + pion
!       cspin (fm^2): total cross section of pion + nucleon
!       cskn (fm^2): total cross section of Kaon + nucleon
!       csnn (fm^2): total cross section of N + N
!       cspsn: total cross section of J/psi (psi') + N
!       cspsm: total cross section of J/psi (psi') + meson
!       rcsit: ratio of inelastic to total cross section
!       kfmax: the maximum # of particles with given flavor code
!       kfaco(i): flavor code of i-th particle among kfmax
!       numb(i): order # of last particle of particles with same flavor of
!        kfaco(i) in particle list
!       cspipiKK (fm^2): cross section of pion + pion to Kaon + Kaon
!       edipi: largest interaction distance between two pions.
!       epin: largest interaction distance between pion and nucleon.
!       ekn: largest interaction distance between Kaon and nucleon.
!       ecsnn: largest interaction distance between two nucleons.
!       t0: average proper formation time at rest.
!       ddt: time accuracy
!       tau(i) : formation time of particle i.
!       ishp(i)=1, i-th particle will participate in the cascade, will not decay
!              =2, reserved for future expansion
!              =3, as 1, but will decay
!              =0, not
!       isinel(i) = 0 without i-th inelastic process
!                 = 1 with i-th inelastic process
!       lc(i,1), lc(i,2): line numbers in the particle list of i-th coll. pair
!       lc(i,3), lc(i,4): flavor codes of scattered particles of i-th coll. pair
!       lc(i,5): the internal inelastic process number
!       lc(i,6): event type. =1, elastic scattering; =2, inelastic; =3, decay.
!       tc(i): collision time of i-th colliding pair
!       tw(i): cross section ratio of (i-th inelas.)/tot
!       pio : 3.141592653589793D0
!       nctl: number of collision pairs in the current collision list
!       nctl0: number of collision pairs in last collision list
!       noinel(i): statistics of the occurring of i-th inelastic process
!       noel: statistics of the occurring of elastic process


        pio  = 3.141592653589793D0
        nctl = 0
        noel = 0
        noinel = 0
        loop_init: do i=1,nsa,1
            tau(i) = vsa(i,4)
            ! Excludes non-hadrons, spectators, historical entries
            !   and the hadrons that are outside of the simulation time.
            ishp(i) = 0
            KS = ksa(i,1)
            KF = ksa(i,2)
            if( .NOT.IS_EXIST(KS,i_mode) .OR. .NOT.INTO_HRS(KF) ) cycle
            if( KF == 2212 .OR. KF == 2112 )then
                pT2 = psa(i,1)**2 + psa(i,2)**2
                if( pT2 < 1D-20 ) cycle
            end if
            ishp(i) = 1
            ! Labels it will decay or not.
            if( IS_ALICE_LONGLIVED( KF ) ) cycle
            do j=1,100,1
                if( KF_woDecay(j) == 0 ) exit
                if( KF == KF_woDecay(j) ) cycle loop_init
            end do
            ishp(i) = 3
        end do loop_init

!       Cross sections are given in fm^2
        PARAM(1) = para1_2
        PARAM(5) = para(5)
        csnn     = PARAM(1)*0.1D0
        cspin    = PARAM(2)*0.1D0
        cskn     = PARAM(3)*0.1D0
        cspipi   = PARAM(4)*0.1D0
        cspipiKK = PARAM(5)*0.1D0
        cspsn    = PARAM(13)*0.1D0
        cspsm    = PARAM(14)*0.1D0
        csspn    = PARAM(15)*0.1D0
        csspm    = PARAM(16)*0.1D0
        iabsb    = 1
        iabsm    = 1
!       PARAM(1) : total cross-section of nucleon + nucleon (in mb)
!       PARAM(5) : cross-section of pi + pi -> K + K (in mb)
!       csnn  : total cross section of nucleon + nucleon
!       1 mb = 0.1 fm^2
!       cspin : total cross section of pion + nucleon
!       cskn  : total cross section of Kaon + nucleon
!       cspipi: total cross section of pion + pion
!       cspsn : total cross section of J/psi (psi') + nucleon
!       cspsm : total cross section of J/psi (psi') + meson
!       iabsb = 0 : without J/psi (psi') + baryon (nucleon)
!             = 1 : with J/psi (psi')    + baryon (nucleon)
!       iabsm = 0 : without J/psi (psi') + meson
!             = 1 : with J/psi (psi')    + meson

!       i_sigma_AQM: = 1, uses the input total cross sections of piN, KN, pi+pi,
!                         Jpsi(psi')+N, Jpsi(psi')+N, Jpsi(psi')+pi/rho,
!                         and AQM cross sections for D+N/pi/rho in hadcas.
!                         Ignores the channels which are not well defined.
!                  : = 2, uses the input cross sections of piN, KN, ... ,
!                         AQM cross sections for D+N/pi/rho and the channels
!                         which are not well defined (treated as elastic).
!                  : = 3, uses AQM cross sections of piN, KN,... and D+N/pi/rho.
!                         Ignores the channels which are not well defined.
!                  : = 4, uses AQM cross sections of piN, KN, ..., D+N/pi/rho,
!                         and the channels which are not well defined (treated
!                         as elastic).

!       Uses the total cross sections from AQM (additive quark model,
!        arXiv:2203.11601)
        i_sigma_AQM = i_sigma_AQM_p
        if( i_sigma_AQM == 3 .OR. i_sigma_AQM == 4 )then
            cspin  = sigma_AQM( 211, 2212, csnn )
            cskn   = sigma_AQM( 321, 2212, csnn )
            cspipi = sigma_AQM( 211,  211, csnn )
            cspsn  = sigma_AQM( 443, 2212, csnn )
            cspsm  = sigma_AQM( 443,  221, csnn )
            csspn  = cspsn
            csspm  = cspsm
        end if

!       Largest interaction distance of two colliding particles.
        edipi  = SQRT(cspipi / pio)
        epin   = SQRT(cspin  / pio)
        ekn    = SQRT(cskn   / pio)
        ecsnn  = SQRT(csnn   / pio)
        ecspsn = SQRT(cspsn  / pio)
        ecspsm = SQRT(cspsm  / pio)
        ecsspn = SQRT(csspn  / pio)
        ecsspm = SQRT(csspm  / pio)

        rcsit = PARAM(6)
        t0    = PARAM(7)
!       dep   = PARAM(9)
!       ddt   = PARAM(8)
        ddt   = adj1(11)
!       rao   = PARAM(10)
        kfmax  = KFMAXT
        kfaco  = KFACOT
        isinel = ISINELT


        return
        end



!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
        LOGICAL FUNCTION INTO_HRS( KF )
!!      Determines whether a particle participates in the hadronic rescattering.
        IMPLICIT NONE
        INTEGER, INTENT(IN) :: KF


        INTO_HRS = ABS( KF ) > 99 .AND. ABS( KF ) < 10000000


        RETURN
        END



!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
        subroutine ctlcre_h
!!      Creates the initial collision list.
        IMPLICIT DOUBLE PRECISION(A-H, O-Z)
        IMPLICIT INTEGER(I-N)
        LOGICAL IS_ALICE_LONGLIVED
        PARAMETER (KSZJ=300000,NSIZE=750000)
        common/sa1_h/nsa,non1,ksa(kszj,5),psa(kszj,5),vsa(kszj,5)
        common/sa8_h/tau(kszj),ishp(kszj)
        common/sa20_h/t0,cspipiKK,dep,ddt,edipi,epin,ecsnn,ekn,ecspsn,ecspsm, &
         rnt,rnp,ecsspn,ecsspm
        common/ctllist_h/nctl,noinel(2000),nctl0,noel
        common/ctllist_t/ lc(nsize,6), tc(nsize), tw(nsize)
        COMMON/SA1_PY8/ i_mode, i_tune, KF_woDecay(100), &
               KF_proj, KF_targ, win, energy_B, psno, b_min, b_max
        integer :: l_coll(6)
        real(kind=8) :: t_coll, t_coll_min
        logical :: succeed


        ! At fisrt, adds decay events to the time list.
        nctl = 0
        do i=1,nsa,1
            if( ishp(i) /= 3 ) cycle
            nctl = nctl + 1
            lc( nctl, 1 ) = i
            lc( nctl, 2 ) = 0
            lc( nctl, 3 ) = 0
            lc( nctl, 4 ) = 0
            lc( nctl, 5 ) = 0
            lc( nctl, 6 ) = 3
            tc( nctl ) = vsa(i,4) + vsa(i,5)
            tw( nctl ) = 1D0
        end do
        nctl0 = nctl

        ! Then adds scattering events.
        dddt = ddt
        nctl = nctl + 1
        do i = 1, nsa-1, 1
            if( ishp(i) == 0 ) cycle
            ! Decay time of particle i.
            t_decay_i = 1D30
            if( ishp(i) == 3 ) t_decay_i = vsa(i,4) + vsa(i,5)
            ! Successful flag.
            succeed = .false.
            ! A number large enough to determine the minumum time.
            t_coll_min = 1D30
            ixc = 0
            jxc = 0
            loop_j: do j = i+1, nsa, 1
                if( ishp(j) == 0 ) cycle
                ! Decay time of particle j.
                t_decay_j = 1D30
                if( ishp(j) == 3 ) t_decay_j = vsa(j,4) + vsa(j,5)
                call rsfilt_h( i, j, iflag )
                if( iflag == 0 ) cycle
                call coij_h( i, j, i_fail, l_coll, t_coll )
                if( i_fail == 1 ) cycle
                if( t_coll < 1D-10 ) cycle
                ! The scattering should happen before particle decays.
                if( t_coll > MIN( t_decay_i, t_decay_j ) ) cycle
                ! Imposes the time resolution constraint.
                do j1 = 1, nctl-1, 1
                    if( ABS( tc(j1) - t_coll ) < dddt ) cycle loop_j
                end do
                i_type = l_coll(6)   !#TODO
                ! Chooses the smallest time for 'i'-cycle.
                if( t_coll < t_coll_min )then
                    lc(nctl,1) = l_coll(1)
                    lc(nctl,2) = l_coll(2)
                    lc(nctl,3) = l_coll(3)
                    lc(nctl,4) = l_coll(4)
                    lc(nctl,5) = l_coll(5)
                    lc(nctl,6) = l_coll(6)
                    tc(nctl)   = t_coll
                    tw(nctl)   = 1D0
                    t_coll_min = t_coll
                    ixc = l_coll(1)
                    jxc = l_coll(2)
                end if
                succeed = .true.
            end do loop_j
            ! Keeps the one with the smallest time from pairs including i or j.
            if( succeed )then
                n_jump_out = 0
                j1 = 1
                do while(.true.)
                    if( j1 > nctl-1 ) exit
                    iic = lc(j1,1)
                    jjc = lc(j1,2)
                    if(       ixc /= iic .AND. ixc /= jjc &
                        .AND. jxc /= iic .AND. jxc /= jjc )then
                        j1  = j1 + 1
                        cycle
                    end if
                    ttc = tc(j1)
                    ! Thows away the pair with larger time.
                    if( ttc > t_coll_min )then
                        k_begin = j1
                        n_jump_out = n_jump_out + 1
                    else
                        k_begin = nctl
                        n_jump_out = 2
                    end if
                    nctl = nctl - 1
                    do k1 = k_begin, nctl, 1
                        lc( k1, 1 ) = lc( k1+1, 1 )
                        lc( k1, 2 ) = lc( k1+1, 2 )
                        lc( k1, 3 ) = lc( k1+1, 3 )
                        lc( k1, 4 ) = lc( k1+1, 4 )
                        lc( k1, 5 ) = lc( k1+1, 5 )
                        lc( k1, 6 ) = lc( k1+1, 6 )
                        tc( k1 ) = tc( k1+1 )
                        tw( k1 ) = tw( k1+1 )
                    end do
                    if( n_jump_out == 2 ) exit
                end do
                ! For the next time finding.
                nctl = nctl + 1
            end if
        end do
        ! Deducts 1 because the counter begins with 1 not 0.
        nctl = nctl - 1


        return
        end



!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
        subroutine scat_h( time )
!!      Administrates the hadon cascade.
        IMPLICIT DOUBLE PRECISION(A-H, O-Z)
        IMPLICIT INTEGER(I-N)
        PARAMETER (KSZJ=300000,NSIZE=750000)
        common/sa1_h/nsa,non1,ksa(kszj,5),psa(kszj,5),vsa(kszj,5)
        common/sa8_h/tau(kszj),ishp(kszj)
        common/sa9_h/kfmax,kfaco(100),numb(100)
        common/sa10_h/csnn,cspin,cskn,cspipi,cspsn,cspsm,rcsit,ifram, &
         iabsb,iabsm,i_sigma_AQM,csspn,csspm
        common/sa19_h/coor(3)
        common/sa20_h/t0,cspipiKK,dep,ddt,edipi,epin,ecsnn,ekn,ecspsn,ecspsm, &
         rnt,rnp,ecsspn,ecsspm
        common/ctllist_h/nctl,noinel(2000),nctl0,noel
        common/ctllist_t/ lc(nsize,6), tc(nsize), tw(nsize)
        dimension pi(4), pj(4), pi00(4), pj00(4), b(3)
        ! i_type: event type. =1, elastic scattering; =2, inelastic; =3, decay.
        ! pi00, pj00: four-momenta before collisions


        time  = 0D0
        nctl0 = nctl


!-------------------------------------------------------------------------------
!-----------------------------   Hadron Cascade   ------------------------------
!       Loops over sub-events within an event.
        n_loop = 0
        do while(.true.)
            nsa0 = nsa

!       Finds an event (icp) with the minimum time (tcp).
            call find_h( icp, tcp )
            time   = tcp
            ic     = lc(icp,1)
            jc     = lc(icp,2)
            i_type = lc(icp,6)
            do i=1,4,1
                pi00(i) = psa(ic,i)
                pj00(i) = psa(jc,i)
            end do

!       Handles a collision (elastic or inelastic) event.
            if( i_type == 1 .OR. i_type == 2 )then
                ! Boosts to the CM frame of the colliding pair.
                pi = pi00
                pj = pj00
                do i=1,3,1
                    b(i)  = ( pi(i) + pj(i) ) / ( pi(4) + pj(4) )
                end do
                call lorntz( 0, b, pi, pj )
                ss = pi(4) + pj(4)
                ! Handles an elastic collision.
                if( i_type == 1 )then
                    ! Calculates four-momenta of scattered particles after the
                    !  elastic collistion (pi and pj in the CM frame).
                    call coelas_h( ic, jc, ss, pi, pj )
                    ! Updates particle list for elastic scattering. pi and pj
                    !   will be boosted back to the Lab frame.
                    call updple_h( ic, jc, b, pi, pj )
                    noel = noel + 1
                ! Handles an inelastic collision.
                else if( i_type == 2 )then
                    call solve_inelastic_kinematics( ic, jc, ss, b, pi, icp )
                end if

!       Handles a decay event.
            else
            end if

!       Performs classical Newton motion in Lab. system.
            call his_h( ic, jc, pi00, pj00, time, i_type )

!       Updates the collision list.
            call updatl_h( ic, jc, icp, nsa0 )

            n_loop = n_loop + 1
            if( nctl == 0 ) exit
        end do
!-----------------------------   Hadron Cascade   ------------------------------
!-------------------------------------------------------------------------------


        return
        end



!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
        subroutine find_h( icp, tcp )
!!      Finds out the binary collision with minimum collision time.
        IMPLICIT DOUBLE PRECISION(A-H, O-Z)
        IMPLICIT INTEGER(I-N)
        PARAMETER(NSIZE=750000)
        common/ctllist_h/nctl,noinel(2000),nctl0,noel
        common/ctllist_t/ lc(nsize,6), tc(nsize), tw(nsize)


        icp = MINLOC( tc( 1 : nctl ), DIM=1 )
        tcp = MINVAL( tc( 1 : nctl ), DIM=1 )


        return
        end



!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
        subroutine his_h( ic, jc, pi00, pj00, time_in, i_type )
!!      Propagates scattering particles to the collision time in the Lab frame.
        IMPLICIT DOUBLE PRECISION(A-H, O-Z)
        IMPLICIT INTEGER(I-N)
        PARAMETER (KSZJ=300000)
        common/sa1_h/nsa,non1,ksa(kszj,5),psa(kszj,5),vsa(kszj,5)
        common/sa8_h/tau(kszj),ishp(kszj)
        common/sa12/ppsa(5),nchan,nsjp,sjp,taup,taujp
        common/sa20_h/t0,cspipiKK,dep,ddt,edipi,epin,ecsnn,ekn,ecspsn,ecspsm, &
         rnt,rnp,ecsspn,ecsspm
        integer, intent(in) :: ic, jc, i_type
        real(kind=8), intent(in) :: pi00(4), pj00(4), time_in
        ! pi00, pj00: four-momenta before collisions
        ! i_type: event type. =1, elastic scattering; =2, inelastic; =3, decay.


        ! Gives the formation time for the inelastic scattering.
        tau_h = 0D0
        if( i_type == 2 ) tau_h = t0 * taup * psa(ic,4) / psa(ic,5)
        time = time_in + tau_h
        do j=1,3,1
            vsa(ic,j) = vsa(ic,j) + pi00(j) / pi00(4) * ( time - vsa(ic,4) )
        end do
        vsa(ic,4) = time
        tau(ic)   = vsa(ic,4)

        ! Gives the formation time for the inelastic scattering.
        tau_h = 0D0
        if( i_type == 2 ) tau_h = t0 * taup * psa(jc,4) / psa(jc,5)
        time = time_in + tau_h
        do j=1,3,1
            vsa(jc,j) = vsa(jc,j) + pj00(j) / pj00(4) * ( time - vsa(jc,4) )
        end do
        vsa(jc,4) = time
        tau(jc)   = vsa(jc,4)


        return
        end



!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
        subroutine coinel( ic, jc, ss, l_coll )
!!      Treats the inelastic collision.
!
!       (F): Forward reaction. (R):Reverse reaction.
!       (A): Anti-particle reaction.
!
!       N: nucleons (p or n); Y: Lambda or Sigma
!
!       The inelastic processes considered are:

!       Strangeness production reactions:
!         1. pion+ + pion- to K+ + K-  (R-201, A-1)
!         2. pion+ + pion- to K0 + K0- (R-205, A-2)
!         3. pion+ + pion0 to K+ + K0- (R-203, A-4)
!         4. pion- + pion0 to K- + K0  (R-204, A-3)
!         5. pion0 + pion0 to K+ + K-  (R-202, A-5)
!         6. pion0 + pion0 to K0 + K0- (R-206, A-6)

!         7. pion+ + p to K+ + Sigma+  (R-207, A-25)
!         8. pion+ + n to K+ + Sigma0  (R-210, A-27)
!         9. pion+ + n to K+ + Lambda  (R-212, A-26)
!        10. pion+ + n to K0 + Sigma+  (R-214, A-28)
!        11. pion- + p to K+ + Sigma-  (R-208, A-23)
!        12. pion- + p to K0 + Lambda  (R-219, A-21)
!        13. pion- + p to K0 + Sigma0  (R-217, A-22)
!        14. pion- + n to K0 + Sigma-  (R-216, A-24)
!        15. pion0 + p to K+ + Sigma0  (R-211, A-30)
!        16. pion0 + p to K+ + Lambda  (R-213, A-29)
!        17. pion0 + p to K0 + Sigma+  (R-215, A-31)
!        18. pion0 + n to K+ + Sigma-  (R-209, A-32)
!        19. pion0 + n to K0 + Lambda  (R-220, A-33)
!        20. pion0 + n to K0 + Sigma0  (R-218, A-34)

!        21. pion+ + pba to K0- + Lambdaba (R-233, A-12)
!        22. pion+ + pba to K0- + Sigma0ba (R-231, A-13)
!        23. pion+ + pba to K-  + Sigma-ba (R-222, A-11)
!        24. pion+ + nba to K0- + Sigma-ba (R-230, A-14)
!        25. pion- + pba to K-  + Sigma+ba (R-221, A-7)
!        26. pion- + nba to K-  + Lambdaba (R-226, A-9)
!        27. pion- + nba to K-  + Sigma0ba (R-224, A-8)
!        28. pion- + nba to K0- + Sigma+ba (R-228, A-10)
!        29. pion0 + pba to K-  + Lambdaba (R-227, A-16)
!        30. pion0 + pba to K-  + Sigma0ba (R-225, A-15)
!        31. pion0 + pba to K0- + Sigma+ba (R-229, A-17)
!        32. pion0 + nba to K-  + Sigma-ba (R-223, A-18)
!        33. pion0 + nba to K0- + Lambdaba (R-234, A-19)
!        34. pion0 + nba to K0- + Sigma0ba (R-232, A-20)

!        35. pion+ + Sigma-   to K+  + Cascade-   (R-235, A-45)
!        36. pion- + Lambda   to K0  + Cascade-   (R-243, A-42)
!        37. pion- + Sigma+   to K+  + Cascade-   (R-236, A-43)
!        38. pion- + Sigma0   to K0  + Cascade-   (R-244, A-44)
!        39. pion0 + Lambda   to K+  + Cascade-   (R-237, A-46)
!        40. pion0 + Sigma-   to K0  + Cascade-   (R-245, A-47)
!        41. pion0 + Sigma0   to K+  + Cascade-   (R-238, A-48)
!        42. pion+ + Lambdaba to K0- + Cascade-ba (R-246, A-36)
!        43. pion+ + Sigma+ba to K-  + Cascade-ba (R-239, A-37)
!        44. pion+ + Sigma0ba to K0- + Cascade-ba (R-247, A-38)
!        45. pion- + Sigma-ba to K-  + Cascade-ba (R-240, A-35)
!        46. pion0 + Lambdaba to K-  + Cascade-ba (R-241, A-39)
!        47. pion0 + Sigma-ba to K0- + Cascade-ba (R-248, A-40)
!        48. pion0 + Sigma0ba to K-  + Cascade-ba (R-242, A-41)

!        Strangeness exchange reactions:
!        49. K-  + p to pion0 + Lambda (R-263, A-66)
!        50. K-  + p to pion0 + Sigma0 (R-261, A-67)
!        51. K-  + p to pion- + Sigma+ (R-254, A-68)
!        52. K-  + p to pion+ + Sigma- (R-249, A-69)
!        53. K-  + p to K+    + Cascade- (strangeness production) (R-253, A-70)
!        54. K-  + n to pion- + Sigma0 (R-256, A-71)
!        55. K-  + n to pion- + Lambda (R-258, A-72)
!        56. K-  + n to pion0 + Sigma- (R-260, A-73)
!        57. K-  + n to K0    + Cascade- (strangeness production) (R-257, A-74)
!        58. K0- + p to pion+ + Lambda (R-252, A-75)
!        59. K0- + p to pion+ + Sigma0 (R-251, A-76)
!        60. K0- + p to pion0 + Sigma+ (R-259, A-77)
!        61. K0- + n to pion+ + Sigma- (R-250, A-78)
!        62. K0- + n to pion- + Sigma+ (R-255, A-79)
!        63. K0- + n to pion0 + Sigma0 (R-262, A-80)
!        64. K0- + n to pion0 + Lambda (R-264, A-81)
!        65. K0- + n to K+    + Cascade- (strangeness production) (R-265, A-82)

!        66. K+ + p- to pion0 + Lambda-  (R-280, A-49)
!        67. K+ + p- to pion0 + Sigma0-  (R-278, A-50)
!        68. K+ + p- to pion+ + Sigma+ba (R-266, A-51)
!        69. K+ + p- to pion- + Sigma-ba (R-271, A-52)
!        70. K+ + p- to K-    + Cascade-ba (strangeness production) (R-270,A-53)
!        71. K+ + n- to pion+ + Sigma0-  (R-268, A-54)
!        72. K+ + n- to pion+ + Lambda-  (R-269, A-55)
!        73. K+ + n- to pion0 + Sigma-ba (R-277, A-56)
!        74. K+ + n- to K0-   + Cascade-ba (strangeness production) (R-274,A-57)
!        75. K0 + p- to pion- + Lambda-  (R-275, A-58)
!        76. K0 + p- to pion- + Sigma0-  (R-273, A-59)
!        77. K0 + p- to pion0 + Sigma+ba (R-276, A-60)
!        78. K0 + n- to pion- + Sigma-ba (R-272, A-61)
!        79. K0 + n- to pion+ + Sigma+ba (R-267, A-62)
!        80. K0 + n- to pion0 + Sigma0-  (R-279, A-63)
!        81. K0 + n- to pion0 + Lambda-  (R-281, A-64)
!        82. K0 + n- to K-    + Cascade-ba (strangeness production) (R-282,A-65)

!        83. K-  + Lambda   to pion0 + Cascade-   (R-287, A-90)
!        84. K-  + Sigma+   to pion+ + Cascade-   (R-283, A-91)
!        85. K-  + Sigma-   to pion- + Cascade-   (R-286, A-92)
!        86. K-  + Sigma0   to pion0 + Cascade-   (R-288, A-93)
!        87. K0- + Lambda   to pion+ + Cascade-   (R-284, A-94)
!        88. K0- + Sigma0   to pion+ + Cascade-   (R-285, A-95)
!        89. K0- + Sigma-   to pion0 + Cascade-   (R-289, A-96)
!        90. K+  + Lambda-  to pion0 + Cascade-ba (R-294, A-83)
!        91. K+  + Sigma+ba to pion- + Cascade-ba (R-291, A-84)
!        92. K+  + Sigma-ba to pion+ + Cascade-ba (R-290, A-85)
!        93. K+  + Sigma0ba to pion0 + Cascade-ba (R-295, A-86)
!        94. K0  + Lambdaba to pion- + Cascade-ba (R-292, A-87)
!        95. K0  + Sigma0ba to pion- + Cascade-ba (R-293, A-88)
!        96. K0  + Sigma-ba to pion0 + Cascade-ba (R-296, A-89)

!        97. pion+ + Sigma-   to K0  + Cascade0  (R-297, A-105)
!        98. pion+ + Sigma0   to K+  + Cascade0  (R-298, A-106)
!        99. pion+ + Lambda   to K+  + Cascade0  (R-299, A-107)
!       100. pion- + Sigma+   to K0  + Cascade0  (R-300, A-104)
!       101. pion0 + Sigma+   to K+  + Cascade0  (R-301, A-108)
!       102. pion0 + Sigma0   to K0  + Cascade0  (R-302, A-109)
!       103. pion0 + Lambda   to K0  + Cascade0  (R-303, A-110)
!       104. pion+ + Sigma+ba to K0- + Cascade0- (R-304, A-100)
!       105. pion- + Sigma-ba to K0- + Cascade0- (R-305, A-97)
!       106. pion- + Sigma0ba to K-  + Cascade0- (R-306, A-98)
!       107. pion- + Lambdaba to K-  + Cascade0- (R-307, A-99)
!       108. pion0 + Sigma+ba to K-  + Cascade0- (R-308, A-101)
!       109. pion0 + Sigma0ba to K0- + Cascade0- (R-309, A-102)
!       110. pion0 + Lambdaba to K0- + Cascade0- (R-310, A-103)

!       111. K-  + Sigma+   to pion0 + Cascade0  (R-311, A-118)
!       112. K-  + Sigma0   to pion- + Cascade0  (R-312, A-119)
!       113. K-  + Lambda   to pion- + Cascade0  (R-313, A-120)
!       114. K0- + Sigma+   to pion+ + Cascade0  (R-314, A-121)
!       115. K0- + Sigma-   to pion- + Cascade0  (R-315, A-122)
!       116. K0- + Sigma0   to pion0 + Cascade0  (R-316, A-123)
!       117. K0- + Lambda   to pion0 + Cascade0  (R-317, A-124)
!       118. K+  + Sigma+ba to pion0 + Cascade0- (R-318, A-111)
!       119. K+  + Sigma0-  to pion+ + Cascade0- (R-319, A-112)
!       120. K+  + Lambda-  to pion+ + Cascade0- (R-320, A-113)
!       121. K0  + Sigma+ba to pion- + Cascade0- (R-321, A-114)
!       122. K0  + Sigma-ba to pion+ + Cascade0- (R-322, A-115)
!       123. K0  + Sigma0-  to pion0 + Cascade0- (R-323, A-116)
!       124. K0  + Lambda-  to pion0 + Cascade0- (R-324, A-117)

!       125. K-  + p  to K0  + Cascade0  (R-325, A-128)
!       126. K0- + p  to K+  + Cascade0  (R-326, A-129)
!       127. K0- + n  to K0  + Cascade0  (R-327, A-130)
!       128. K+  + p- to K0- + Cascade0- (R-328, A-125)
!       129. K0  + p- to K-  + Cascade0- (R-329, A-126)
!       130. K0  + n- to K0- + Cascade0- (R-330, A-127)

!       131. pion+ + Cascade-   to K+    + Omega-   (R-331, A-133)
!       132. pion0 + Cascade-   to K0    + Omega-   (R-332, A-134)
!       133. pion- + Cascade-ba to K-    + Omega-ba (R-333, A-131)
!       134. pion0 + Cascade-ba to K0-   + Omega-ba (R-334, A-132)
!       135. pion- + Cascade0   to K0    + Omega-   (R-335, A-137)
!       136. pion0 + Cascade0   to K+    + Omega-   (R-336, A-138)
!       137. pion+ + Cascade0-  to K0-   + Omega-ba (R-337, A-135)
!       138. pion0 + Cascade0-  to K-    + Omega-ba (R-338, A-136)
!       139. K-    + Cascade-   to pion- + Omega-   (R-339, A-143)
!       140. K0-   + Cascade-   to pion0 + Omega-   (R-340, A-144)
!       141. K-    + Cascade0   to pion0 + Omega-   (R-341, A-145)
!       142. K0-   + Cascade0   to pion+ + Omega-   (R-342, A-146)
!       143. K+    + Cascade-ba to pion+ + Omega-ba (R-343, A-139)
!       144. K0    + Cascade-ba to pion0 + Omega-ba (R-344, A-140)
!       145. K+    + Cascade0-  to pion0 + Omega-ba (R-345, A-141)
!       146. K0    + Cascade0-  to pion- + Omega-ba (R-346, A-142)

!       147. pion- + p to pion+ + Delta-  (R-347, A-497)
!       148. pion- + p to rho0  + n       (R-363, A-498)
!       149. pion- + p to rho-  + p       (R-371, A-499)
!       150. pion- + p to pion- + Delta+  (R-360, A-500)
!       151. pion- + p to pion0 + Delta0  (R-356, A-501)
!       152. pion- + n to pion0 + Delta-  (R-357, A-502)
!       153. pion- + n to rho-  + n       (R-365, A-503)
!       154. pion- + n to pion- + Delta0  (R-362, A-504)
!       155. pion+ + p to pion0 + Delta++ (R-352, A-505)
!       156. pion+ + p to pion+ + Delta+  (R-351, A-506)
!       157. pion+ + p to rho+  + p       (R-372, A-507)
!       158. pion+ + n to pion- + Delta++ (R-359, A-508)
!       159. pion+ + n to pion+ + Delta0  (R-349, A-509)
!       160. pion+ + n to pion0 + Delta+  (R-354, A-510)
!       161. pion+ + n to rho0  + p       (R-369, A-511)
!       162. pion+ + n to rho+  + n       (R-367, A-512)
!       163. pion0 + p to pion+ + Delta0  (R-350, A-513)
!       164. pion0 + p to pion- + Delta++ (R-358, A-514)
!       165. pion0 + p to rho+  + n       (R-366, A-515)
!       166. pion0 + p to rho0  + p       (R-368, A-516)
!       167. pion0 + p to pion0 + Delta+  (R-353, A-517)
!       168. pion0 + n to pion- + Delta+  (R-361, A-518)
!       169. pion0 + n to pion+ + Delta-  (R-348, A-519)
!       170. pion0 + n to pion0 + delta0  (R-355, A-520)
!       171. pion0 + n to rho0  + n       (R-364, A-521)
!       172. pion0 + n to rho-  + p       (R-370, A-522)

!       N + N
!       173. p + p to p + Delta+  (R-375, A-549)
!       174. p + p to n + Delta++ (R-373, A-550)
!       175. p + n to n + Delta+  (R-374, A-551)
!       176. p + n to p + Delta0  (R-376, A-552)
!       177. n + n to n + Delta0  (R-377, A-553)
!       178. n + n to p + Delta-  (R-378, A-554)

!       J/psi + N
!       179. J/psi + n to Lamda_c+  + D-    (R-?, A-?561)
!       180. J/psi + n to Sigma_c+  + D-    (R-?, A-?562)
!       181. J/psi + n to Sigma_c0  + Dbar0 (R-?, A-?563)
!       182. J/psi + p to Lamda_c+  + Dbar0 (R-?, A-?564)
!       183. J/psi + p to Sigma_c+  + Dbar0 (R-?, A-?565)
!       184. J/psi + p to Sigma_c++ + D-    (R-?, A-?566)

!       J/psi + pi/rho
!       185. J/psi + pion+ to D+ + D*bar0 (R-?, A-?567)
!       186. J/psi + pion0 to D0 + D*bar0 (R-?, A-?568)
!       187. J/psi + pion0 to D+ + D*-    (R-?, A-?569)
!       188. J/psi + pion- to D0 + D*-    (R-?, A-?570)
!       189. J/psi + rho+  to D+ + Dbar0  (R-?, A-?571)
!       190. J/psi + rho0  to D0 + Dbar0  (R-?, A-?572)
!       191. J/psi + rho0  to D+ + D-     (R-?, A-?573)
!       192. J/psi + rho-  to D0 + D-     (R-?, A-?574)

!       psi' + N
!       193. psi' + n to Lamda_c+  + D-    (R-?, A-?575)
!       194. psi' + n to Sigma_c+  + D-    (R-?, A-?576)
!       195. psi' + n to Sigma_c0  + Dbar0 (R-?, A-?577)
!       196. psi' + p to Lamda_c+  + Dbar0 (R-?, A-?578)
!       197. psi' + p to Sigma_c+  + Dbar0 (R-?, A-?579)
!       198. psi' + p to Sigma_c++ + D-    (R-?, A-?580)

!       psi' + pi/rho (other parts are 379~384)
!       199. psi' + pion+ to D+ + D*bar0 (R-?, A-?581)
!       200. psi' + pion0 to D0 + D*bar0 (R-?, A-?582)

!       pi & K induced reverse reactions, after "201"
!       201. K+ + K-  to pion+ + pion- (F-1, A-201)
!       202. K+ + K-  to pion0 + pion0 (F-5, A-202)
!       203. K+ + K0- to pion+ + pion0 (F-3, A-204)
!       204. K- + K0  to pion- + pion0 (F-4, A-203)
!       205. K0 + K0- to pion+ + pion- (F-2, A-205)
!       206. K0 + K0- to pion0 + pion0 (F-6, A-206)

!       207. K+ + Sigma+ to pion+ + p  (F-7,  A-221)
!       208. K+ + Sigma- to pion- + p  (F-11, A-222)
!       209. K+ + Sigma- to pion0 + n  (F-18, A-223)
!       210. K+ + Sigma0 to pion+ + n  (F-8,  A-224)
!       211. K+ + Sigma0 to pion0 + p  (F-15, A-225)
!       212. K+ + Lambda to pion+ + n  (F-9,  A-226)
!       213. K+ + Lambda to pion0 + p  (F-16, A-227)
!       214. K0 + Sigma+ to pion+ + n  (F-10, A-228)
!       215. K0 + Sigma+ to pion0 + p  (F-17, A-229)
!       216. K0 + Sigma- to pion- + n  (F-14, A-230)
!       217. K0 + Sigma0 to pion- + p  (F-13, A-231)
!       218. K0 + Sigma0 to pion0 + n  (F-20, A-232)
!       219. K0 + Lambda to pion- + p  (F-12, A-233)
!       220. K0 + Lambda to pion0 + n  (F-19, A-234)

!       221. K-  + Sigma+ba to pion- + pba (F-25, A-207)
!       222. K-  + Sigma-ba to pion+ + pba (F-23, A-208)
!       223. K-  + Sigma-ba to pion0 + nba (F-32, A-209)
!       224. K-  + Sigma0ba to pion- + nba (F-27, A-210)
!       225. K-  + Sigma0ba to pion0 + pba (F-30, A-211)
!       226. K-  + Lambdaba to pion- + nba (F-26, A-212)
!       227. K-  + Lambdaba to pion0 + pba (F-29, A-213)
!       228. K0- + Sigma+ba to pion- + nba (F-28, A-214)
!       229. K0- + Sigma+ba to pion0 + pba (F-31, A-215)
!       230. K0- + Sigma-ba to pion+ + nba (F-24, A-216)
!       231. K0- + Sigma0ba to pion+ + pba (F-22, A-217)
!       232. K0- + Sigma0ba to pion0 + nba (F-34, A-218)
!       233. K0- + Lambdaba to pion+ + pba (F-21, A-219)
!       234. K0- + Lambdaba to pion0 + nba (F-33, A-220)

!       235. K+  + Cascade-   to pion+ + Sigma-   (F-35, A-240)
!       236. K+  + Cascade-   to pion- + Sigma+   (F-37, A-239)
!       237. K+  + Cascade-   to pion0 + Lambda   (F-39, A-241)
!       238. K+  + Cascade-   to pion0 + Sigma0   (F-41, A-242)
!       239. K-  + Cascade-ba to pion+ + Sigma+ba (F-43, A-236)
!       240. K-  + Cascade-ba to pion- + Sigma-ba (F-45, A-235)
!       241. K-  + Cascade-ba to pion0 + Lambda-  (F-46, A-237)
!       242. K-  + Cascade-ba to pion0 + Sigma0-  (F-48, A-238)
!       243. K0  + Cascade-   to pion- + Lambda   (F-36, A-246)
!       244. K0  + Cascade-   to pion- + Sigma0   (F-38, A-247)
!       245. K0  + Cascade-   to pion0 + Sigma-   (F-40, A-248)
!       246. K0- + Cascade-ba to pion+ + Lambda-  (F-42, A-243)
!       247. K0- + Cascade-ba to pion+ + Sigma0-  (F-44, A-244)
!       248. K0- + Cascade-ba to pion0 + Sigma-ba (F-47, A-245)

!       249. pion+ + Sigma-   to K-  + p (F-52, A-271)
!       250. pion+ + Sigma-   to K0- + n (F-61, A-272)
!       251. pion+ + Sigma0   to K0- + p (F-59, A-273)
!       252. pion+ + Lambda   to K0- + p (F-58, A-275)
!       253. K+    + Cascade- to K-  + p (F-53, A-270)
!       254. pion- + Sigma+   to K-  + p (F-51, A-266)
!       255. pion- + Sigma+   to K0- + n (F-62, A-267)
!       256. pion- + Sigma0   to K-  + n (F-54, A-268)
!       257. K0    + Cascade- to K-  + n (F-57, A-274)
!       258. pion- + Lambda   to K-  + n (F-55, A-269)
!       259. pion0 + Sigma+   to K0- + p (F-60, A-276)
!       260. pion0 + Sigma-   to K-  + n (F-56, A-277)
!       261. pion0 + Sigma0   to K-  + p (F-50, A-278)
!       262. pion0 + Sigma0   to K0- + n (F-63, A-279)
!       263. pion0 + Lambda   to K-  + p (F-49, A-280)
!       264. pion0 + Lambda   to K0- + n (F-64, A-281)
!       265. K+    + Cascade- to K0- + n (F-65, A-282)

!       266. pion+ + Sigma+ba   to K+ + pba (F-68, A-254)
!       267. pion+ + Sigma+ba   to K0 + nba (F-79, A-255)
!       268. pion+ + Sigma0-    to K+ + nba (F-71, A-256)
!       269. pion+ + Lambda-    to K+ + nba (F-72, A-258)
!       270. K-    + Cascade-ba to K+ + pba (F-69, A-253)
!       271. pion- + Sigma-ba   to K+ + pba (F-69, A-249)
!       272. pion- + Sigma-ba   to K0 + nba (F-78, A-250)
!       273. pion- + Sigma0-    to K0 + pba (F-76, A-251)
!       274. K0-   + Cascade-ba to K+ + nba (F-74, A-257)
!       275. pion- + Lambda-    to K0 + pba (F-75, A-252)
!       276. pion0 + Sigma+ba   to K0 + pba (F-77, A-259)
!       277. pion0 + Sigma-ba   to K+ + nba (F-73, A-260)
!       278. pion0 + Sigma0-    to K+ + pba (F-67, A-261)
!       279. pion0 + Sigma0-    to K0 + nba (F-80, A-262)
!       280. pion0 + Lambda-    to K+ + pba (F-66, A-263)
!       281. pion0 + Lambda-    to K0 + nba (F-82, A-264)
!       282. K-    + Cascade-ba to K0 + nba (F-82, A-265)

!       283. pion+ + Cascade-   to K-  + Sigma+   (F-84, A-291)
!       284. pion+ + Cascade-   to K0- + Lambda   (F-87, A-292)
!       285. pion+ + Cascade-   to K0- + Sigma0   (F-88, A-293)
!       286. pion- + Cascade-   to K-  + Sigma-   (F-85, A-290)
!       287. pion0 + Cascade-   to K-  + Lambda   (F-82, A-294)
!       288. pion0 + Cascade-   to K-  + Sigma0   (F-86, A-295)
!       289. pion0 + Cascade-   to K0- + Sigma-   (F-89, A-296)
!       290. pion+ + Cascade-ba to K+  + Sigma-ba (F-92, A-286)
!       291. pion- + Cascade-ba to K+  + Sigma+ba (F-91, A-283)
!       292. pion- + Cascade-ba to K0  + Lambdaba (F-94, A-284)
!       293. pion- + Cascade-ba to K0  + Sigma0ba (F-95, A-285)
!       294. pion0 + Cascade-ba to K+  + Lambdaba (F-90, A-287)
!       295. pion0 + Cascade-ba to K+  + Sigma0ba (F-93, A-288)
!       296. pion0 + Cascade-ba to K0  + Sigma-ba (F-96, A-289)

!       297. K0  + Cascade0  to pion+ + Sigma-   (F-97,  A-305)
!       298. K+  + Cascade0  to pion+ + Sigma0   (F-98,  A-306)
!       299. K+  + Cascade0  to pion+ + Lambda   (F-99,  A-307)
!       300. K0  + Cascade0  to pion- + Sigma+   (F-100, A-304)
!       301. K+  + Cascade0  to pion0 + Sigma+   (F-101, A-308)
!       302. K0  + Cascade0  to pion0 + Sigma0   (F-102, A-309)
!       303. K0  + Cascade0  to pion0 + Lambda   (F-103, A-310)
!       304. K0- + Cascade0- to pion+ + Sigma+ba (F-104, A-230)
!       305. K0- + Cascade0- to pion- + Sigma-ba (F-105, A-297)
!       306. K-  + Cascade0- to pion- + Sigma0ba (F-106, A-298)
!       307. K-  + Cascade0- to pion- + Lambdaba (F-107, A-299)
!       308. K-  + Cascade0- to pion0 + Sigma+ba (F-108, A-301)
!       309. K0- + Cascade0- to pion0 + Sigma0ba (F-109, A-302)
!       310. K0- + Cascade0- to pion0 + Lambdaba (F-110, A-303)

!       311. pion0 + Cascade0  to K-  + Sigma+   (F-111, A-318)
!       312. pion- + Cascade0  to K-  + Sigma0   (F-112, A-319)
!       313. pion- + Cascade0  to K-  + Lambda   (F-113, A-320)
!       314. pion+ + Cascade0  to K0- + Sigma+   (F-114, A-321)
!       315. pion- + Cascade0  to K0- + Sigma-   (F-115, A-322)
!       316. pion0 + Cascade0  to K0- + Sigma0   (F-116, A-323)
!       317. pion0 + Cascade0  to K0- + Lambda   (F-117, A-324)
!       318. pion0 + Cascade0- to K+  + Sigma+ba (F-118, A-311)
!       319. pion+ + Cascade0- to K+  + Sigma0-  (F-119, A-312)
!       320. pion+ + Cascade0- to K+  + Lambda-  (F-120, A-313)
!       321. pion- + Cascade0- to K0  + Sigma+ba (F-121, A-314)
!       322. pion+ + Cascade0- to K0  + Sigma-ba (F-122, A-315)
!       323. pion0 + Cascade0- to K0  + Sigma0-  (F-123, A-316)
!       324. pion0 + Cascade0- to K0  + Lambda-  (F-124, A-317)

!       325. K0  + Cascade0  to K-  + p  (F-125, A-328)
!       326. K+  + Cascade0  to K0- + p  (F-126, A-329)
!       327. K0  + Cascade0  to K0- + n  (F-127, A-330)
!       328. K0- + Cascade0- to K+  + p- (F-128, A-325)
!       329. K-  + Cascade0- to K0  + p- (F-129, A-326)
!       330. K0- + Cascade0- to K0  + n- (F-130, A-327)

!       331. K+    + Omega-   to pion+ + Cascade-   (F-131, A-333)
!       332. K0    + Omega-   to pion0 + Cascade-   (F-132, A-334)
!       333. K-    + Omega-ba to pion- + Cascade-ba (F-133, A-331)
!       334. K0-   + Omega-ba to pion0 + Cascade-ba (F-134, A-332)
!       335. K0    + Omega-   to pion- + Cascade0   (F-135, A-337)
!       336. K+    + Omega-   to pion0 + Cascade0   (F-136, A-338)
!       337. K0-   + Omega-ba to pion+ + Cascade0-  (F-137, A-335)
!       338. K-    + Omega-ba to pion0 + Cascade0-  (F-138, A-336)
!       339. pion- + Omega-   to K-    + Cascade-   (F-139, A-343)
!       340. pion0 + Omega-   to K0-   + Cascade-   (F-140, A-344)
!       341. pion0 + Omega-   to K-    + Cascade0   (F-141, A-345)
!       342. pion+ + Omega-   to K0-   + Cascade0   (F-142, A-346)
!       343. pion+ + Omega-ba to K+    + Cascade-ba (F-143, A-339)
!       344. pion0 + Omega-ba to K0    + Cascade-ba (F-144, A-340)
!       345. pion0 + Omega-ba to K+    + Cascade0-  (F-145, A-341)
!       346. pion- + Omega-ba to K0    + Cascade0-  (F-146, A-342)

!       347. pion+ + Delta-  to pion- + p (F-147, A-523)
!       348. pion+ + Delta-  to pion0 + n (F-169, A-524)
!       349. pion+ + Delta0  to pion+ + n (F-159, A-525)
!       350. pion+ + Delta0  to pion0 + p (F-163, A-526)
!       351. pion+ + Delta+  to pion+ + p (F-156, A-527)
!       352. pion0 + Delta++ to pion+ + p (F-155, A-528)
!       353. pion0 + Delta+  to pion0 + p (F-167, A-529)
!       354. pion0 + Delta+  to pion+ + n (F-160, A-530)
!       355. pion0 + Delta0  to pion0 + n (F-170, A-531)
!       356. pion0 + Delta0  to pion- + p (F-151, A-532)
!       357. pion0 + Delta-  to pion- + n (F-152, A-533)
!       358. pion- + Delta++ to pion0 + p (F-164, A-534)
!       359. pion- + Delta++ to pion+ + n (F-158, A-535)
!       360. pion- + Delta+  to pion- + p (F-150, A-536)
!       361. pion- + Delta+  to pion0 + n (F-168, A-537)
!       362. pion- + Delta0  to pion- + n (F-154, A-538)
!       363. rho0  + n       to pion- + p (F-148, A-539)
!       364. rho0  + n       to pion0 + n (F-171, A-540)
!       365. rho-  + n       to pion- + n (F-153, A-541)
!       366. rho+  + n       to pion0 + p (F-165, A-542)
!       367. rho+  + n       to pion+ + n (F-162, A-543)
!       368. rho0  + p       to pion0 + p (F-166, A-544)
!       369. rho0  + p       to pion+ + n (F-161, A-545)
!       370. rho-  + p       to pion0 + n (F-172, A-546)
!       371. rho-  + p       to pion- + p (F-149, A-547)
!       372. rho+  + p       to pion+ + p (F-157, A-548)

!       373. n + Delta++ to p + p (F-174, A-555)
!       374. n + Delta+  to p + n (F-175, A-556)
!       375. p + Delta+  to p + p (F-173, A-557)
!       376. p + Delta0  to p + n (F-176, A-558)
!       377. n + Delta0  to n + n (F-177, A-559)
!       378. p + Delta-  to n + n (F-178, A-560)

!       Follows are forward reactions again.
!       psi' + pi/rho (other parts are 199~200)
!       379. psi' + pion0 to D+ + D*-   (R-?, A-?583)
!       380. psi' + pion- to D0 + D*-   (R-?, A-?584)
!       381. psi' + rho+  to D+ + Dbar0 (R-?, A-?585)
!       382. psi' + rho0  to D0 + Dbar0 (R-?, A-?586)
!       383. psi' + rho0  to D+ + D-    (R-?, A-?587)
!       384. psi' + rho-  to D0 + D-    (R-?, A-?588)

!       D meson induced reactions.
!=======================================================================
!       80 channels of D + pion/rho channels: 385-464
!       32 channels of D + N channels: 465-496
!       Total 112 channels: 385-496
!-----------------------------------------------------------------------
!       D + pion/rho
!       Single production channels.
!
!       Charge ++, --
!       D+- + pion+-/rho+-
!       385. D+  + pi+   -->  D*+ + rho+ (R-391, A-386)
!       386. D-  + pi-   -->  D*- + rho- (R-392, A-385)
!       387. D*+ + pi+   -->  D+  + rho+ (R-389, A-388)
!       388. D*- + pi-   -->  D-  + rho- (R-390, A-387)
!       389. D+  + rho+  -->  D*+ + pi+  (F-387, A-390)
!       390. D-  + rho-  -->  D*- + pi-  (F-388, A-389)
!       391. D*+ + rho+  -->  D+  + pi+  (F-385, A-392)
!       392. D*- + rho-  -->  D-  + pi-  (F-386, A-391)
!
!       Charge 0- KF+-, Charge 0+ KF-+
!       D0 + pion+-/rho+-
!       393. D0     + pi-   -->  D*0    + rho- (R-399, A-394)
!       394. Dbar0  + pi+   -->  D*bar0 + rho+ (R-400, A-393)
!       395. D*0    + pi-   -->  D0     + rho- (R-397, A-396)
!       396. D*bar0 + pi+   -->  Dbar0  + rho+ (R-398, A-395)
!       397. D0     + rho-  -->  D*0    + pi-  (F-395, A-398)
!       398. Dbar0  + rho+  -->  D*bar0 + pi+  (F-396, A-397)
!       399. D*0    + rho-  -->  D0     + pi-  (F-393, A-400)
!       400. D*bar0 + rho+  -->  Dbar0  + pi+  (F-394, A-399)
!-----------------------------------------------------------------------
!       D + pion/rho
!       Dual production channels.
!
!       Charge 00
!       D0 + pi0/rho0
!       401. D0     + pi0   -->  D*0    + rho0 (R-413, A-403)
!       402. D0     + pi0   -->  D*+    + rho- (R-430, A-404)
!       403. Dbar0  + pi0   -->  D*bar0 + rho0 (R-415, A-401)
!       404. Dbar0  + pi0   -->  D*-    + rho+ (R-432, A-402)
!       405. D*0    + pi0   -->  D0     + rho0 (R-409, A-407)
!       406. D*0    + pi0   -->  D+     + rho- (R-426, A-408)
!       407. D*bar0 + pi0   -->  Dbar0  + rho0 (R-411, A-405)
!       408. D*bar0 + pi0   -->  D-     + rho+ (R-428, A-406)
!       409. D0     + rho0  -->  D*0    + pi0  (F-405, A-411)
!       410. D0     + rho0  -->  D*+    + pi-  (R-422, A-412)
!       411. Dbar0  + rho0  -->  D*bar0 + pi0  (F-407, A-409)
!       412. Dbar0  + rho0  -->  D*-    + pi+  (R-424, A-410)
!       413. D*0    + rho0  -->  D0     + pi0  (F-401, A-415)
!       414. D*0    + rho0  -->  D+     + pi-  (R-418, A-416)
!       415. D*bar0 + rho0  -->  Dbar0  + pi0  (F-402, A-413)
!       416. D*bar0 + rho0  -->  D-     + pi+  (R-420, A-414)
!
!       Charge +-, -+
!       D+- + pi+-/rho+-
!       417. D+  + pi-   -->  D*+    + rho- (R-429, A-419)
!       418. D+  + pi-   -->  D*0    + rho0 (F-414, A-420)
!       419. D-  + pi+   -->  D*-    + rho+ (R-431, A-417)
!       420. D-  + pi+   -->  D*bar0 + rho0 (F-416, A-418)
!       421. D*+ + pi-   -->  D+     + rho- (R-425, A-423)
!       422. D*+ + pi-   -->  D0     + rho0 (F-410, A-424)
!       423. D*- + pi+   -->  D-     + rho+ (R-427, A-421)
!       424. D*- + pi+   -->  Dbar0  + rho0 (F-412, A-422)
!       425. D+  + rho-  -->  D*+    + pi-  (F-421, A-427)
!       426. D+  + rho-  -->  D*0    + pi0  (F-406, A-428)
!       427. D-  + rho+  -->  D*-    + pi+  (F-423, A-425)
!       428. D-  + rho+  -->  D*bar0 + pi0  (F-408, A-426)
!       429. D*+ + rho-  -->  D+     + pi-  (F-417, A-431)
!       430. D*+ + rho-  -->  D0     + pi0  (F-402, A-432)
!       431. D*- + rho+  -->  D-     + pi+  (F-419, A-429)
!       432. D*- + rho+  -->  Dbar0  + pi0  (F-404, A-430)
!
!       Charge +0, -0
!       D+- + pi0/rho0
!       433. D+  + pi0   -->  D*+    + rho0 (R-445, A-435)
!       434. D+  + pi0   -->  D*0    + rho+ (R-462, A-436)
!       435. D-  + pi0   -->  D*-    + rho0 (R-447, A-433)
!       436. D-  + pi0   -->  D*bar0 + rho- (R-464, A-434)
!       437. D*+ + pi0   -->  D+     + rho0 (R-441, A-439)
!       438. D*+ + pi0   -->  D0     + rho+ (R-458, A-440)
!       439. D*- + pi0   -->  D-     + rho0 (R-443, A-437)
!       440. D*- + pi0   -->  Dbar0  + rho- (R-460, A-438)
!       441. D+  + rho0  -->  D*+    + pi0  (F-437, A-443)
!       442. D+  + rho0  -->  D*0    + pi+  (R-454, A-444)
!       443. D-  + rho0  -->  D*-    + pi0  (F-439, A-441)
!       444. D-  + rho0  -->  D*bar0 + pi-  (R-456, A-442)
!       445. D*+ + rho0  -->  D+     + pi0  (F-433, A-447)
!       446. D*+ + rho0  -->  D0     + pi+  (R-450, A-448)
!       447. D*- + rho0  -->  D-     + pi0  (F-435, A-445)
!       448. D*- + rho0  -->  Dbar0  + pi-  (R-452, A-446)
!
!       Charge 0+ KF++, Charge 0- KF --
!       D0 + pi+-/rho+-
!       449. D0     + pi+   -->  D*0    + rho+ (R-461, A-451)
!       450. D0     + pi+   -->  D*+    + rho0 (F-446, A-452)
!       451. Dbar0  + pi-   -->  D*bar0 + rho- (R-463, A-449)
!       452. Dbar0  + pi-   -->  D*-    + rho0 (F-448, A-450)
!       453. D*0    + pi+   -->  D0     + rho+ (R-457, A-455)
!       454. D*0    + pi+   -->  D+     + rho0 (F-442, A-456)
!       455. D*bar0 + pi-   -->  Dbar0  + rho- (R-459, A-453)
!       456. D*bar0 + pi-   -->  D-     + rho0 (F-444, A-454)
!       457. D0     + rho+  -->  D*0    + pi+  (F-453, A-459)
!       458. D0     + rho+  -->  D*+    + pi0  (F-438, A-460)
!       459. Dbar0  + rho-  -->  D*bar0 + pi-  (F-455, A-457)
!       460. Dbar0  + rho-  -->  D*-    + pi0  (F-440, A-458)
!       461. D*0    + rho+  -->  D0     + pi+  (F-449, A-463)
!       462. D*0    + rho+  -->  D+     + pi0  (F-434, A-464)
!       463. D*bar0 + rho-  -->  Dbar0  + pi-  (F-451, A-461)
!       464. D*bar0 + rho-  -->  D-     + pi0  (F-436, A-462)
!-----------------------------------------------------------------------
!       D+- + N
!       465. D+  + p+    -->  D*+ + p+   (R-473, A-470)
!       466. D+  + p-    -->  D*+ + p-   (R-474, A-469)
!       467. D+  + n     -->  D*+ + n    (R-475, A-472)
!       468. D+  + nbar  -->  D*+ + nbar (R-476, A-471)
!       469. D-  + p+    -->  D*- + p+   (R-477, A-466)
!       470. D-  + p-    -->  D*- + p-   (R-478, A-465)
!       471. D-  + n     -->  D*- + n    (R-479, A-468)
!       472. D-  + nbar  -->  D*- + nbar (R-480, A-467)
!       473. D*+ + p+    -->  D+  + p+   (F-465, A-478)
!       474. D*+ + p-    -->  D+  + p-   (F-466, A-477)
!       475. D*+ + n     -->  D+  + n    (F-467, A-480)
!       476. D*+ + nbar  -->  D+  + nbar (F-468, A-479)
!       477. D*- + p+    -->  D-  + p+   (F-469, A-474)
!       478. D*- + p-    -->  D-  + p-   (F-470, A-473)
!       479. D*- + n     -->  D-  + n    (F-471, A-476)
!       480. D*- + nbar  -->  D-  + nbar (F-472, A-475)
!
!       D0 + N
!       481. D0     + p+    -->  D*0    + p+   (R-489, A-486)
!       482. D0     + p-    -->  D*0    + p-   (R-490, A-485)
!       483. D0     + n     -->  D*0    + n    (R-491, A-488)
!       484. D0     + nbar  -->  D*0    + nbar (R-492, A-487)
!       485. Dbar0  + p+    -->  D*bar0 + p+   (R-493, A-482)
!       486. Dbar0  + p-    -->  D*bar0 + p-   (R-494, A-481)
!       487. Dbar0  + n     -->  D*bar0 + n    (R-495, A-484)
!       488. Dbar0  + nbar  -->  D*bar0 + nbar (R-496, A-483)
!       489. D*0    + p+    -->  D0     + p+   (F-481, A-494)
!       490. D*0    + p-    -->  D0     + p-   (F-482, A-493)
!       491. D*0    + n     -->  D0     + n    (F-483, A-496)
!       492. D*0    + nbar  -->  D0     + nbar (F-484, A-495)
!       493. D*bar0 + p+    -->  Dbar0  + p+   (F-485, A-490)
!       494. D*bar0 + p-    -->  Dbar0  + p-   (F-486, A-489)
!       495. D*bar0 + n     -->  Dbar0  + n    (F-487, A-492)
!       496. D*bar0 + nbar  -->  Dbar0  + nbar (F-488, A-491)
!=======================================================================
!       D meson induced reactions.

!       497. pion+ + pba to pion- + Delta-ba  (R-523, A-147)
!       498. pion+ + pba to rho0  + nba       (R-539, A-148)
!       499. pion+ + pba to rho+  + pba       (R-547, A-149)
!       500. pion+ + pba to pion+ + Delta+ba  (R-536, A-150)
!       501. pion+ + pba to pion0 + Delta0ba  (R-532, A-151)
!       502. pion+ + nba to pion0 + Delta-ba  (R-533, A-152)
!       503. pion+ + nba to rho+  + nba       (R-541, A-153)
!       504. pion+ + nba to pion+ + Delta0ba  (R-538, A-154)
!       505. pion- + pba to pion0 + Delta++ba (R-528, A-155)
!       506. pion- + pba to pion- + Delta+ba  (R-527, A-156)
!       507. pion- + pba to rho-  + pba       (R-548, A-157)
!       508. pion- + nba to pion+ + Delta++ba (R-535, A-158)
!       509. pion- + nba to pion- + Delta0ba  (R-525, A-159)
!       510. pion- + nba to pion0 + Delta+ba  (R-530, A-160)
!       511. pion- + nba to rho0  + pba       (R-545, A-161)
!       512. pion- + nba to rho-  + nba       (R-543, A-162)
!       513. pion0 + pba to pion- + Delta0ba  (R-526, A-163)
!       514. pion0 + pba to pion+ + Delta++ba (R-534, A-164)
!       515. pion0 + pba to rho-  + nba       (R-542, A-165)
!       516. pion0 + pba to rho0  + pba       (R-544, A-166)
!       517. pion0 + pba to pion0 + Delta+ba  (R-529, A-167)
!       518. pion0 + nba to pion+ + Delta+ba  (R-537, A-168)
!       519. pion0 + nba to pion- + Delta-ba  (R-524, A-169)
!       520. pion0 + nba to pion0 + delta0ba  (R-531, A-170)
!       521. pion0 + nba to rho0  + nba       (R-540, A-171)
!       522. pion0 + nba to rho+  + pba       (R-546, A-172)

!       523. pion- + Delta-ba  to pion+ + pba (F-497, A-347)
!       524. pion- + Delta-ba  to pion0 + nba (F-519, A-348)
!       525. pion- + Delta0ba  to pion- + nba (F-509, A-349)
!       526. pion- + Delta0ba  to pion0 + pba (F-513, A-350)
!       527. pion- + Delta+ba  to pion- + pba (F-506, A-351)
!       528. pion0 + Delta++ba to pion- + pba (F-505, A-352)
!       529. pion0 + Delta+ba  to pion0 + pba (F-517, A-353)
!       530. pion0 + Delta+ba  to pion- + nba (F-510, A-354)
!       531. pion0 + Delta0ba  to pion0 + nba (F-520, A-355)
!       532. pion0 + Delta0ba  to pion+ + pba (F-501, A-356)
!       533. pion0 + Delta-ba  to pion+ + nba (F-502, A-357)
!       534. pion+ + Delta++ba to pion0 + pba (F-514, A-358)
!       535. pion+ + Delta++ba to pion- + nba (F-508, A-359)
!       536. pion+ + Delta+ba  to pion+ + pba (F-500, A-360)
!       537. pion+ + Delta+ba  to pion0 + nba (F-518, A-361)
!       538. pion+ + Delta0ba  to pion+ + nba (F-504, A-362)
!       539. rho0  + nba       to pion+ + pba (F-498, A-363)
!       540. rho0  + nba       to pion0 + nba (F-521, A-364)
!       541. rho+  + nba       to pion+ + nba (F-503, A-365)
!       542. rho-  + nba       to pion0 + pba (F-515, A-366)
!       543. rho-  + nba       to pion- + nba (F-512, A-367)
!       544. rho0  + pba       to pion0 + pba (F-516, A-368)
!       545. rho0  + pba       to pion- + nba (F-511, A-369)
!       546. rho+  + pba       to pion0 + nba (F-522, A-370)
!       547. rho+  + pba       to pion+ + pba (F-499, A-371)
!       548. rho-  + pba       to pion- + pba (F-507, A-372)

!       549. pba + pba to pba + Delta+ba  (R-557, A-173)
!       550. pba + pba to nba + Delta++ba (R-555, A-174)
!       551. pba + nba to nba + Delta+ba  (R-556, A-175)
!       552. pba + nba to pba + Delta0ba  (R-558, A-176)
!       553. nba + nba to nba + Delta0ba  (R-559, A-177)
!       554. nba + nba to pba + Delta-ba  (R-560, A-178)

!       555. nba + Delta++ba to pba + pba (F-550, A-373)
!       556. nba + Delta+ba  to pba + nba (F-551, A-374)
!       557. pba + Delta+ba  to pba + pba (F-549, A-375)
!       558. pba + Delta0ba  to pba + nba (F-552, A-376)
!       559. nba + Delta0ba  to nba + nba (F-553, A-377)
!       560. pba + Delta-ba  to nba + nba (F-554, A-378)

!#TODO(Lei20250130): expand-------------------------------B
!       561-588, 28 channels
!
!       J/psi + N (Anti-particle)
!       561. J/psi + nba to Lamda_cbar-  + D+ (R-?, A-179)
!       562. J/psi + nba to Sigma_cbar-  + D+ (R-?, A-180)
!       563. J/psi + nba to Sigma_cbar0  + D0 (R-?, A-181)
!       564. J/psi + pba to Lamda_cbar-  + D0 (R-?, A-182)
!       565. J/psi + pba to Sigma_cbar-  + D0 (R-?, A-183)
!       566. J/psi + pba to Sigma_cbar-- + D+ (R-?, A-184)

!       J/psi + pi/rho (Anti-particle)
!       567. J/psi + pion- to D-    + D*0 (R-?, A-185)
!       568. J/psi + pion0 to Dbar0 + D*0 (R-?, A-186)
!       569. J/psi + pion0 to D-    + D*+ (R-?, A-187)
!       570. J/psi + pion+ to Dbar0 + D*+ (R-?, A-188)
!       571. J/psi + rho-  to D-    + D0  (R-?, A-189)
!       572. J/psi + rho0  to Dbar0 + D0  (R-?, A-190)
!       573. J/psi + rho0  to D-    + D+  (R-?, A-191)
!       574. J/psi + rho+  to Dbar0 + D+  (R-?, A-192)

!       psi' + N (Anti-particle)
!       575. psi' + n to Lamda_c+  + D-    (R-?, A-193)
!       576. psi' + n to Sigma_c+  + D-    (R-?, A-194)
!       577. psi' + n to Sigma_c0  + Dbar0 (R-?, A-195)
!       578. psi' + p to Lamda_c+  + Dbar0 (R-?, A-196)
!       579. psi' + p to Sigma_c+  + Dbar0 (R-?, A-197)
!       580. psi' + p to Sigma_c++ + D-    (R-?, A-198)

!       psi' + pi/rho (Anti-particle)
!       581. psi' + pion+ to D+ + D*bar0 (R-?, A-199)
!       582. psi' + pion0 to D0 + D*bar0 (R-?, A-200)
!       583. psi' + pion0 to D+ + D*-    (R-?, A-379)
!       584. psi' + pion- to D0 + D*-    (R-?, A-380)
!       585. psi' + rho+  to D+ + Dbar0  (R-?, A-381)
!       586. psi' + rho0  to D0 + Dbar0  (R-?, A-382)
!       587. psi' + rho0  to D+ + D-     (R-?, A-383)
!       588. psi' + rho-  to D0 + D-     (R-?, A-384)
!
!       561-588, 28 channels
!#TODO(Lei20250130): expand-------------------------------E

!       589. Lambda + pba to K*-   + omega (R-601, A-593)
!       590. Lambda + nba to K*0ba + omega (R-602, A-594)
!       591. Sigma0 + pba to K*-   + omega (R-603, A-595)
!       592. Sigma0 + nba to K*0ba + omega (R-604, A-596)

!       593. Lambdaba + p to K*+ + omega (R-605, A-589)
!       594. Lambdaba + n to K*0 + omega (R-606, A-590)
!       595. Sigma0ba + p to K*+ + omega (R-607, A-591)
!       596. Sigma0ba + n to K*0 + omega (R-608, A-592)

!       597. pba + p to rho0 + omega (R-609, A-597)
!       598. pba + n to rho- + omega (R-610, A-599)
!       599. nba + p to rho+ + omega (R-611, A-598)
!       600. nba + n to rho0 + omega (R-612, A-600)

!       601. K*-   + omega to Lambda + pba (F-589, A-605)
!       602. K*0ba + omega to Lambda + nba (F-590, A-606)
!       603. K*-   + omega to Sigma0 + pba (F-591, A-607)
!       604. K*0ba + omega to Sigma0 + nba (F-592, A-608)

!       605. K*+ + omega to Lambdaba + p (F-593, A-601)
!       606. K*0 + omega to Lambdaba + n (F-594, A-602)
!       607. K*+ + omega to Sigma0ba + p (F-595, A-603)
!       608. K*0 + omega to Sigma0ba + n (F-596, A-604)

!       609. rho0 + omega to pba + p (F-597, A-597)
!       610. rho- + omega to pba + n (F-598, A-599)
!       611. rho+ + omega to nba + p (F-599, A-598)
!       612. rho0 + omega to nba + n (F-600, A-600)

        IMPLICIT DOUBLE PRECISION(A-H, O-Z)
        IMPLICIT INTEGER(I-N)
        PARAMETER (KSZJ=300000)
        common/sa1_h/nsa,non1,ksa(kszj,5),psa(kszj,5),vsa(kszj,5)
!       Note the name of the arrays in 'sa1' in this subroutine.
        common/sa10_h/csnn,cspin,cskn,cspipi,cspsn,cspsm,rcsit,ifram, &
         iabsb,iabsm,i_sigma_AQM,csspn,csspm
        common/ctllist_h/nctl,noinel(2000),nctl0,noel
        integer, intent(in) :: ic, jc
        real(kind=8), intent(in) :: ss
        integer :: l_coll(6)


        KF1    = ksa(ic,2)
        KF2    = ksa(jc,2)
!       The following statements guarantees the line number in particle
!        list of mesons is the first component of prod(). But anbitry order
!        for other cases, i.e. meason+meson or baryon+baryon.
        i4_KF1 = MOD( ABS(KF1)/1000, 10 )
        if( i4_KF1 == 0 )then
            ! Tries to finds the inelastic production.
            call prod( KF1, KF2, ss, l_coll, tw, i_succ )
        else
            call prod( KF2, KF1, ss, l_coll, tw, i_succ )
        end if

        l_coll(1) = ic
        l_coll(2) = jc

!       tw: the cross section ratio of (i-th inela.)/tot
!       1/rcsit : the cross section ratio of tot/(inela.)
        w1 = tw / rcsit
!       Treated as elastic.
        if( i_succ == 0 .OR. PYR(1) > w1 )then
            l_coll(3) = KF1
            l_coll(4) = KF2
            l_coll(5) = 0
            l_coll(6) = 1
            return
        end if

!       lc6: event type. =1, elastic scattering; =2, inelastic; =3, decay.
        l_coll(6) = 2


        return
        end



!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
        subroutine solve_inelastic_kinematics( l, l1, ss, b, pi, icp )
!!      Determines the inelastic outgoing four-momentum.
        IMPLICIT DOUBLE PRECISION(A-H, O-Z)
        IMPLICIT INTEGER(I-N)
        PARAMETER (KSZJ=300000,NSIZE=750000)
        PARAMETER (pio=3.141592653589793D0)
        common/sa1_h/nsa,non1,ksa(kszj,5),psa(kszj,5),vsa(kszj,5)
        common/ctllist_h/nctl,noinel(2000),nctl0,noel
        common/ctllist_t/ lc(nsize,6), tc(nsize), tw(nsize)
        integer, intent(in) :: l, l1, icp
        real(kind=8), intent(in) :: ss
        real(kind=8) :: b(3)
        real(kind=8) :: pi(4), pii(4), pjj(4)


        am01  = psa(l,5)
        am02  = psa(l1,5)
        ik1   = lc(icp,3)
        ik2   = lc(icp,4)
        fi1   = PYANGL( pi(1), pi(2) )
        cta1  = PYANGL( pi(3), SQRT( pi(1)**2 + pi(2)**2 ) )
        cfi1  = COS(fi1)
        sfi1  = SIN(fi1)
        ccta1 = COS(cta1)
        scta1 = SIN(cta1)
        am1   = PYMASS(ik1)
        am2   = PYMASS(ik2)
        pp    = (ss**2 - (am1 + am2)**2)*(ss**2 - (am1 - am2)**2) / (4D0*ss**2)
!       Too small/zero momentum.
        if( pp < 1D-10 ) return
        pp = SQRT(pp)
        pii(4) = ( ss**2 + am1**2 - am2**2 ) / ( 2D0*ss )
!       Energy of one particle (between two) after scattering.
        fis  = 2D0 * pio * PYR(1)
        cfis = COS(fis)
        sfis = SIN(fis)
!       Quasi-elastic angular distribution for an inelastic scattering.
        call cosin( am01, am1, ss, pi, pp, cctas )
!       Isotropical distribution for an inelastic scattering.
!       cctas = 2D0*PYR(1) - 1D0
        sctas = SQRT( 1D0 - cctas*cctas )
        pii(1) = cfi1 * ( ccta1*sctas*cfis + scta1*cctas ) - sfi1*sctas*sfis
        pii(2) = sfi1 * ( ccta1*sctas*cfis + scta1*cctas ) + cfi1*sctas*sfis
        pii(3) = ccta1*cctas - scta1*sctas*cfis
        pii(1) = pp*pii(1)
        pii(2) = pp*pii(2)
        pii(3) = pp*pii(3)
        do i=1,3,1
            pjj(i) = 0D0 - pii(i)
        end do
        pjj(4) = ss - pii(4)
        ilo = 1
        call lorntz(ilo,b,pii,pjj)

!       Feeds back the scatterd momenta.
        ! l
        ksa(l,1) = 151
        ksa(l,2) = ik1
        ksa(l,3) = l
        ksa(l,4) = 0
        ksa(l,5) = 0
        do i=1,4,1
            psa(l,1) = pii(i)
        end do
        psa(l,5) = am1
        ! l1
        ksa(l1,1) = 151
        ksa(l1,2) = ik2
        ksa(l1,3) = l1
        ksa(l1,4) = 0
        ksa(l1,5) = 0
        do i=1,4,1
            psa(l1,1) = pjj(i)
        end do
        psa(l1,5) = am2

!       Counts inelastic collisions.
        icp5 = lc(icp,5)
        noinel(icp5) = noinel(icp5) + 1


        return
        end



!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
        subroutine cosin(am01,am1,eij,pi,pp,cctas)
!!      Calculates cos(theta_s).
        IMPLICIT DOUBLE PRECISION(A-H, O-Z)
        IMPLICIT INTEGER(I-N)
        dimension pi(4)


        eij = eij
!       d = 3.65D0 * ( eij - am1 - am2 )
!       if( d < 1D-10 )return
        pt = 0.5D0
        a  = MIN( 10.3D0, 1D0 / ( 1.12D0 * pt ) / ( 1.12D0 * pt ) )
!       d6 = d**6
!       B  = d6 * A / ( 1D0 + d6 )
!       changed from 10.3 to 'A'
        B = A
!       if( B < 1D-20 )then
!           B = 1D-20
!       end if
        pm2  = pi(1)**2 + pi(2)**2 + pi(3)**2
        pm   = SQRT(pm2)
        em   = SQRT( pm2 + am01*am01 )
        em1  = SQRT( pp*pp + am1*am1 )
        tmin = am01**2 + am1**2 - 2D0 * ( em*em1 + pm*pp )
        tmax = am01**2 + am1**2 - 2D0 * ( em*em1 - pm*pp )
        abt = EXP( MAX( -7.0D2, B*tmin ) )
        abu = EXP( MAX( -7.0D2, B*tmax ) )
        cc  = PYR(1)
        tt1 = LOG( cc*abu + (1D0 - cc) * abt )
        tt = tt1 / B
        cctas = ( 0.5D0 * ( tt - am01**2 - am1**2 ) + em*em1 ) / ( pm * pp )
        if( ABS(cctas) > 1D0 ) cctas = SIGN( 1D0, cctas )


        return
        end



!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
        subroutine prod( kl, kl1, ss, lc, tw, i_succ )
!!      Calculates particle production weight and fills up lc(i,3-5), tw(i).
!       One must keep the the first "kl" is meson and the second "kl1" is baryon
!        for meson + baryon collisions.
!       kl, kl1: KF code of incoming particles
!       ss: invariant mass of the collision pair
        IMPLICIT DOUBLE PRECISION(A-H, O-Z)
        IMPLICIT INTEGER(I-N)
        INTEGER PYCHGE
        common/iloval/ilo1,ilo2,ilo3,ilo4,ilo5,ilo6,ilo7,ilo8,ilo9
        integer, intent(in) :: kl, kl1
        real(kind=8), intent(in) :: ss
        integer :: lc(6)


        i_succ = 0
        ilo1 = 1
        ilo2 = 1
        ilo3 = 1
        ilo4 = 1
        ilo5 = 1
        ilo6 = 1
        ilo7 = 1
        ilo8 = 1
        ilo9 = 1

!       lc3, lc4: KF code of outgoing particles in a inelastic collisions
!       lc5: No. label of the inelastic collision
!       tw : the ratio of cross section of (given inela.)/tot
        tw = 0D0
!       Total charge of the initial state.
        nchargei = PYCHGE(kl) + PYCHGE(kl1)

!-------------------------------------------------------------------------------
!       pion induced reactions
!       pion + pion
        if(       ( ABS(kl)  == 111 .OR. ABS(kl)  == 211 ) &
            .AND. ( ABS(kl1) == 111 .OR. ABS(kl1) == 211 ) )then
            call pipi_coll( kl, kl1, ss, lc, tw, i_succ )

!       pion + N (the order has been specified when calling "prod")
        else if(  ( ABS(kl)  == 111  .OR. ABS(kl)  == 211  ) &
            .AND. ( ABS(kl1) == 2212 .OR. ABS(kl1) == 2112 ) )then
            call piN_coll( kl, kl1, ss, lc, tw, i_succ )

!       pion + Delta (the order has been specified when calling "prod")
        else if(  ( ABS(kl)  == 111  .OR. ABS(kl)  == 221 ) &
            .AND. ( ABS(kl1) == 1114 .OR. ABS(kl1) == 2114  &
            .OR.    ABS(kl1) == 2214 .OR. ABS(kl1) == 2224 ) )then
            call piDelta_coll( kl, kl1, ss, lc, tw, i_succ )

!       pion + Y (the order has been specified when calling "prod")
        else if(  ( ABS(kl)  == 111  .OR. ABS(kl)  == 221 ) &
            .AND. ( ABS(kl1) == 3122 .OR. ABS(kl1) == 3112  &
            .OR.    ABS(kl1) == 3212 .OR. ABS(kl1) == 3222 ) )then
            call piY_coll( kl, kl1, ss, lc, tw, i_succ )

!       pion + Cascade (the order has been specified when calling "prod")
        else if(  ( ABS(kl)  == 111  .OR. ABS(kl)  == 221 ) &
            .AND. ( ABS(kl1) == 3312 .OR. ABS(kl1) == 3322 ) )then
            call piCascade_coll( kl, kl1, ss, lc, tw, i_succ )

!       pion + Omega (the order has been specified when calling "prod")
        else if(  ( ABS(kl)  == 111  .OR. ABS(kl)  == 221 ) &
            .AND.   ABS(kl1) == 3334 )then
            call piOmega_coll( kl, kl1, ss, lc, tw, i_succ )

!-------------------------------------------------------------------------------
!       Kaon induced reactions
!       Kaon + Kaon
        else if(  ( ABS(kl)  == 311 .OR. ABS(kl)  == 321 ) &
            .AND. ( ABS(kl1) == 311 .OR. ABS(kl1) == 321 ) )then
            call KK_coll( kl, kl1, ss, lc, tw, i_succ )

!       Kaon + N (the order has been specified when calling "prod")
        else if(  ( ABS(kl)  == 311  .OR. ABS(kl)  == 321  ) &
            .AND. ( ABS(kl1) == 2212 .OR. ABS(kl1) == 2112 ) )then
            call KN_coll( kl, kl1, ss, lc, tw, i_succ )

!       Kaon + Y (the order has been specified when calling "prod")
        else if(  ( ABS(kl)  == 311  .OR. ABS(kl)  == 321 ) &
            .AND. ( ABS(kl1) == 3122 .OR. ABS(kl1) == 3112  &
            .OR.    ABS(kl1) == 3212 .OR. ABS(kl1) == 3222 ) )then
            call KY_coll( kl, kl1, ss, lc, tw, i_succ )

!       Kaon + Cascade (the order has been specified when calling "prod")
        else if(  ( ABS(kl)  == 311  .OR. ABS(kl)  == 321 )  &
            .AND. ( ABS(kl1) == 3312 .OR. ABS(kl1) == 3322 ) )then
            call KCascade_coll( kl, kl1, ss, lc, tw, i_succ )

!       Kaon + Omega (the order has been specified when calling "prod")
        else if(  ( ABS(kl)  == 311  .OR. ABS(kl)  == 321 ) &
            .AND.   ABS(kl1) == 3334 )then
            call KOmega_coll( kl, kl1, ss, lc, tw, i_succ )

!-------------------------------------------------------------------------------
!       N incuced reactions
!       N + N
        else if(      ( ABS(kl)  == 2212 .OR. ABS(kl)  == 2112 ) &
                .AND. ( ABS(kl1) == 2212 .OR. ABS(kl1) == 2112 ) )then
            call NN_coll( kl, kl1, ss, lc, tw, i_succ )

!       N + Delta
        else if( ( ( ABS(kl)  == 2212 .OR. ABS(kl)  == 2112 )   &
            .AND.  ( ABS(kl1) == 1114 .OR. ABS(kl1) == 2114     &
            .OR.     ABS(kl1) == 2214 .OR. ABS(kl1) == 2224 ) ) &
            .OR. ( ( ABS(kl1) == 2212 .OR. ABS(kl1) == 2112 )   &
            .AND.  ( ABS(kl)  == 1114 .OR. ABS(kl)  == 2114     &
            .OR.     ABS(kl)  == 2214 .OR. ABS(kl)  == 2224 ) ) )then
            call NDelta_coll( kl, kl1, ss, lc, tw, i_succ )

!       N + Y
        else if( ( ( ABS(kl)  == 2212 .OR. ABS(kl)  == 2112 )   &
            .AND.  ( ABS(kl1) == 3122 .OR. ABS(kl1) == 3112     &
            .OR.     ABS(kl1) == 3212 .OR. ABS(kl1) == 3222 ) ) &
            .OR. ( ( ABS(kl1) == 2212 .OR. ABS(kl1) == 2112 )   &
            .AND.  ( ABS(kl)  == 3122 .OR. ABS(kl)  == 3112     &
            .OR.     ABS(kl)  == 3212 .OR. ABS(kl)  == 3222 ) ) )then
            call NY_coll( kl, kl1, ss, lc, tw, i_succ )

!-------------------------------------------------------------------------------
!       rho meson induced reactions
!       rho + N
        else if(  ( ABS(kl)  == 113  .OR. ABS(kl)  == 213 ) &
            .AND. ( ABS(kl1) == 2212 .OR. ABS(kl1) == 2112 ) )then
            call rhoN_coll( kl, kl1, ss, lc, tw, i_succ )

!       rho + omega
        else if( ( ( ABS(kl)  == 113 .OR. ABS(kl)  == 213 ) &
            .AND.    ABS(kl1) == 223 ) &
            .OR. ( ( ABS(kl1) == 113 .OR. ABS(kl1) == 213 ) &
            .AND.    ABS(kl)  == 223 )  )then
            call rho_omega_coll( kl, kl1, ss, lc, tw, i_succ )

!-------------------------------------------------------------------------------
!       K* meson induced reactions
!       K* + omega
        else if( ( ( ABS(kl)  == 313 .OR. ABS(kl)  == 323 ) &
            .AND.    ABS(kl1) == 223 ) &
            .OR. ( ( ABS(kl1) == 313 .OR. ABS(kl1) == 323 ) &
            .AND.    ABS(kl)  == 223 )  )then
            call Kstar_omega_coll( kl, kl1, ss, lc, tw, i_succ )

!-------------------------------------------------------------------------------
!       D meson induced reactions
!       D meson + pion/rho ( pion/rho + D meson )
        else if( ( ( ABS(kl)  == 411 .OR. ABS(kl)  == 421     &
            .OR.     ABS(kl)  == 413 .OR. ABS(kl)  == 423 )   &
            .AND.  ( ABS(kl1) == 211 .OR. ABS(kl1) == 111     &
            .OR.     ABS(kl1) == 213 .OR. ABS(kl1) == 113 ) ) &
            .OR. ( ( ABS(kl1) == 411 .OR. ABS(kl1) == 421     &
            .OR.     ABS(kl1) == 413 .OR. ABS(kl1) == 423 )   &
            .AND.  ( ABS(kl)  == 211 .OR. ABS(kl)  == 111     &
            .OR.     ABS(kl)  == 213 .OR. ABS(kl)  == 113 ) ) )then
            call DMeson_coll( kl, kl1, ss, lc, tw, i_succ )

!       D meson + N (the order has been specified when calling "prod")
        else if(  ( ABS(kl)  == 411  .OR. ABS(kl)  == 421     &
            .OR.    ABS(kl)  == 413  .OR. ABS(kl)  == 423  )  &
            .AND. ( ABS(kl1) == 2212 .OR. ABS(kl1) == 2112 ) )then
            call DN_coll( kl, kl1, ss, lc, tw, i_succ )

!-------------------------------------------------------------------------------
!       J/psi & psi' meson induced reactions
!       J/psi & psi' + pion
        else if( ( ( ABS(kl)  == 443 .OR. ABS(kl)  == 100443 )   &
            .AND.  ( ABS(kl1) == 211 .OR. ABS(kl1) == 111    ) ) &
            .OR. ( ( ABS(kl1) == 443 .OR. ABS(kl1) == 100443 )   &
            .OR.   ( ABS(kl)  == 211 .OR. ABS(kl)  == 111    ) ) )then
            call psi_pi_coll( kl, kl1, ss, lc, tw, i_succ )

!       J/psi & psi' + Kaon
        else if( ( ( ABS(kl)  == 443 .OR. ABS(kl)  == 100443 )   &
            .AND.  ( ABS(kl1) == 321 .OR. ABS(kl1) == 311    ) ) &
            .OR. ( ( ABS(kl1) == 443 .OR. ABS(kl1) == 100443 )   &
            .OR.   ( ABS(kl)  == 321 .OR. ABS(kl)  == 311    ) ) )then
            call psi_K_coll( kl, kl1, ss, lc, tw, i_succ )

!       J/psi & psi' + rho
        else if( ( ( ABS(kl)  == 443 .OR. ABS(kl)  == 100443 )   &
            .AND.  ( ABS(kl1) == 213 .OR. ABS(kl1) == 113    ) ) &
            .OR. ( ( ABS(kl1) == 443 .OR. ABS(kl1) == 100443 )   &
            .OR.   ( ABS(kl)  == 213 .OR. ABS(kl)  == 113    ) ) )then
            call psi_rho_coll( kl, kl1, ss, lc, tw, i_succ )

!       J/psi & psi' + N
        else if( ( ( ABS(kl)  == 443  .OR. ABS(kl)  == 100443 )   &
            .AND.  ( ABS(kl1) == 2212 .OR. ABS(kl1) == 2112   ) ) &
            .OR. ( ( ABS(kl1) == 443  .OR. ABS(kl1) == 100443 )   &
            .OR.   ( ABS(kl)  == 2212 .OR. ABS(kl)  == 2112   ) ) )then
            call psi_N_coll( kl, kl1, ss, lc, tw, i_succ )

!-------------------------------------------------------------------------------
!       Undefined inelastic channels.
        else
            write(*,*) "No inel. channel is found in hadcas prod(), " &
                    // "treated as elastic collision, KF1, KF2 =", kl, kl1
        end if

!       Treats it as elastics scattering.
        if( i_succ == 0 ) return

!       Total charge of the final state.
        nchargef = PYCHGE( lc(3) ) + PYCHGE( lc(4) )
        if( nchargei /= nchargef )then
            write(*,*) "Warning! prod: charges were not conserved, " &
                    // "initial, final charge, No. of inelastic channel=", &
                        nchargei/3D0, nchargef/3D0, lc(5)
            tw = 0D0
            i_succ = 0
        end if


        return
        end



!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
        subroutine pipi_coll( kl, kl1, ss, lc, tw, ioo )
!!      A part of "prod" to deal with pi + pi --> ...
!       Finds production and fills up lc(i,3-5), tw(i).
!       pion + pion channels are defined as 1-6.
!       kl, kl1: the KF code.
!       ss: the total energy (invariant mass) of two hadrons.
!       lc: collision list.
!       tw: the ratio of cross section of (special inela.)/tot.
!       ioo: flag of elastic (0) and inelastic (1) treatment.
        IMPLICIT DOUBLE PRECISION(A-H, O-Z)
        IMPLICIT INTEGER(I-N)
        common/sa10_h/csnn,cspin,cskn,cspipi,cspsn,cspsm,rcsit,ifram, &
         iabsb,iabsm,i_sigma_AQM,csspn,csspm
        common/sa20_h/t0,cspipiKK,dep,ddt,edipi,epin,ecsnn,ekn,ecspsn,ecspsm, &
         rnt,rnp,ecsspn,ecsspm
        common/iloval/ilo1,ilo2,ilo3,ilo4,ilo5,ilo6,ilo7,ilo8,ilo9
        common/count_h/isinel(2000)
        integer :: lc(6)


        ioo   = 0
        fact1 = 0D0
        fact2 = 0D0

!       pion+ + pion-
        if( (kl == 211 .and. kl1 == -211) &
            .or.(kl == -211 .and. kl1 == 211) )then
            if(isinel(1) == 0)then
                fact1 = 0D0
                goto 101
            end if
            fact1 = 1D0
            ik3=-321
            ik4=321
            ic3=1
            call spipi(ik3,ik4,ss,ilo1)
            if(ilo1 == 0) fact1 = 0D0
101         if(isinel(2) == 0)then
                fact2 = 0D0
                goto 102
            endif
            fact2 = 1D0
            ik5=-311
            ik6=311
            ic5=2
            call spipi(ik5,ik6,ss,ilo2)
            if(ilo2 == 0) fact2 = 0D0
102         fact=fact1+fact2
            if( fact1 <= 1D-15 .AND. fact2 <= 1D-15 ) return
            lc(3)=ik3
            lc(4)=ik4
            lc(5)=ic3
            if(PYR(1) > fact1/fact)then
                lc(3)=ik5
                lc(4)=ik6
                lc(5)=ic5
            endif
            tw=fact*cspipiKK/cspipi

!       pion+ + pion0
        else if( (kl == 211 .and. kl1 == 111) &
            .or.(kl == 111 .and. kl1 == 211) )then
            if(isinel(3) == 0) return
            ik3=-311
            ik4=321
            call spipi(ik3,ik4,ss,ilo1)
            if(ilo1 == 0) return
            lc(3)=ik3
            lc(4)=ik4
            lc(5)=3
            tw=cspipiKK/cspipi

!       pion- + pion0
        else if( (kl == -211 .and. kl1 == 111) &
            .or.(kl == 111 .and. kl1 == -211) )then
            if(isinel(4) == 0) return
            ik3=311
            ik4=-321
            call spipi(ik3,ik4,ss,ilo1)
            if(ilo1 == 0) return
            lc(3)=ik3
            lc(4)=ik4
            lc(5)=4
            tw=cspipiKK/cspipi

!       pion0 + pion0
        else if( kl == 111 .and. kl1 == 111 )then
            if(isinel(5) == 0)then
                fact1 = 0D0
                goto 103
            endif
            fact1 = 1D0
            ik3=-321
            ik4=321
            ic3=5
            call spipi(ik3,ik4,ss,ilo1)
            if(ilo1 == 0) fact1 = 0D0
103         if(isinel(6) == 0)then
                fact2 = 0D0
                goto 104
            endif
            fact2 = 1D0
            ik5=-311
            ik6=311
            ic5=6
            call spipi(ik5,ik6,ss,ilo2)
            if(ilo2 == 0) fact2 = 0D0
104         fact=fact1+fact2
            if( fact1 <= 1D-5 .AND. fact2 <= 1D-5 ) return
            lc(3)=ik3
            lc(4)=ik4
            lc(5)=ic3
            if(PYR(1) > fact1/fact)then
                lc(3)=ik5
                lc(4)=ik6
                lc(5)=ic5
            endif
            tw=fact*cspipiKK/cspipi

        else
            write(*,*) "Warning! pipi_coll: some channels are missing. " &
                    // "KF1, KF2 =", kl, kl1
            return
        endif

        ioo = 1


        return
        end



!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
        subroutine spipi(lc3,lc4,ss,ilo)
!!      A part of "pipi_coll". Checks the threshold energy of the pi+pi reaction.
        IMPLICIT DOUBLE PRECISION(A-H, O-Z)
        IMPLICIT INTEGER(I-N)


        am1 = PYMASS(lc3)
        am2 = PYMASS(lc4)
        ilo=1
        if( ss < (am1 + am2) ) ilo = 0


        return
        end



!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
        subroutine piN_coll( kl, kl1, ss, lc, tw, ioo )
!!      A part of "prod" to deal with pi + N --> ...
!       Finds production and fills up lc(i,3-5), tw(i).
!       pion + N channels are defined as 7-34, 147-172, 497-522.
!       kl, kl1: the KF code.
!       ss: the total energy (invariant mass) of two hadrons.
!       lc: collision list.
!       tw: the ratio of cross section of (special inela.)/tot.
!       ioo: flag of elastic (0) and inelastic (1) treatment.
        IMPLICIT DOUBLE PRECISION(A-H, O-Z)
        IMPLICIT INTEGER(I-N)
        common/sa10_h/csnn,cspin,cskn,cspipi,cspsn,cspsm,rcsit,ifram, &
         iabsb,iabsm,i_sigma_AQM,csspn,csspm
        common/sa20_h/t0,cspipiKK,dep,ddt,edipi,epin,ecsnn,ekn,ecspsn,ecspsm, &
         rnt,rnp,ecsspn,ecsspm
        common/iloval/ilo1,ilo2,ilo3,ilo4,ilo5,ilo6,ilo7,ilo8,ilo9
        common/count_h/isinel(2000)
        integer :: lc(6)


        ioo = 0

!       pi + N
        if( kl1 > 0 )then

!       pion+ + p
            if( kl == 211 .and. kl1 == 2212 )then
                call pip1(ss,lc,tw,ioo)
!       pion+ + n
            else if( kl == 211 .and. kl1 == 2112 )then
                call pin1(ss,lc,tw,ioo)
!       pion- + p
            else if( kl == -211 .and. kl1 == 2212 )then
                call pip2(ss,lc,tw,ioo)
!       pion- + n
            else if( kl == -211 .and. kl1 == 2112 )then
                call pin2(ss,lc,tw,ioo)
!       pion0 + p
            else if( kl == 111 .and. kl1 == 2212 )then
                call pip3(ss,lc,tw,ioo)
!       pion0 + n
            else if( kl == 111 .and. kl1 == 2112 )then
                call pin3(ss,lc,tw,ioo)
            else
                write(*,*) "Warning! piN_coll-N: some channels are missing. " &
                        // "KF1, KF2 =", kl, kl1
            endif

!       pi + Nbar
        else

!       pion- + pbar
            if( kl == -211 .and. kl1 == -2212 )then
                call pi_pbar1(ss,lc,tw,ioo)
!       pion- + nbar
            else if( kl == -211 .and. kl1 == -2112 )then
                call pi_nbar1(ss,lc,tw,ioo)
!       pion+ + pbar
            else if( kl == 211 .and. kl1 == -2212 )then
                call pi_pbar2(ss,lc,tw,ioo)
!       pion+ + nbar
            else if( kl == 211 .and. kl1 == -2112 )then
                call pi_nbar2(ss,lc,tw,ioo)
!       pion0 + pbar
            else if( kl == 111 .and. kl1 == -2212 )then
                call pi_pbar3(ss,lc,tw,ioo)
!       pion0 + nbar
            else if( kl == 111 .and. kl1 == -2112 )then
                call pi_nbar3(ss,lc,tw,ioo)
            else
                write(*,*) "Warning! piN_coll-Nbar: some channels " &
                        // "are missing. KF1, KF2 =", kl, kl1
            endif

        end if


        return
        end



!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
        subroutine pip1(ss,lc,tw,ioo)
!!      A part of "piN_coll" to deal with pion+ + p to ...
        IMPLICIT DOUBLE PRECISION(A-H, O-Z)
        IMPLICIT INTEGER(I-N)
        INTEGER PYCOMP
!       Calculates particle production weight and fills up lc(i,3-5),tw(i).
!       tw : the ratio of cross section of (special inela.)/tot
        COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4)
        COMMON/PYCIDAT2/KFMAXT,NONT2,PARAM(100)
        SAVE /PYCIDAT2/
        common/sa10_h/csnn,cspin,cskn,cspipi,cspsn,cspsm,rcsit,ifram, &
         iabsb,iabsm,i_sigma_AQM,csspn,csspm
        common/count_h/isinel(2000)
        common/iloval/ilo1,ilo2,ilo3,ilo4,ilo5,ilo6,ilo7,ilo8,ilo9
        integer :: lc(6)


        ioo = 0
        if(isinel(7) == 0)then
            sigma1=0.
            goto 212
        endif
        the=PMAS(PYCOMP(321),1)+PMAS(PYCOMP(3222),1)
        sigma1=s1713(ss,ilo1,0,the)
!       Cross section of pion+ + p to K+ + Sigma+.
212     if(isinel(155) == 0)then
            sigma2=0.
            goto 213
        endif
!       the: threshold energy of a reaction
        the=PMAS(PYCOMP(111),1)+PMAS(PYCOMP(2224),1)
        sigma2=sdelta(ss,ilo2,0,the)
!       Cross section of pion+ + p to Delta++ + pi0.
213     if(isinel(157) == 0)then
            sigma3=0.
            goto 214
        endif
        the=PMAS(PYCOMP(213),1)+PMAS(PYCOMP(2212),1)
        sigma3=srho(ss,ilo3,0,the)
!       Cross section of pion+ + p to rho+ + p.
214     if(isinel(156) == 0)then
            sigma4=0.
            goto 804
        endif
        the=PMAS(PYCOMP(211),1)+PMAS(PYCOMP(2214),1)
        sigma4=sdelta(ss,ilo4,0,the)
!       Cross section of pion+ + p to delta+ + pion+.
804     if(ilo1 == 0 .and. ilo2 == 0 .and. ilo3 == 0 &
            .and. ilo4 == 0) return
        if(sigma1 < 1D-6 .and. sigma2 < 1D-6 .and. sigma3 < 1D-6 &
            .and. sigma4 < 1D-6 ) return
        sigma12=sigma1+sigma2
        sigma13=sigma12+sigma3
        sigma14=sigma13+sigma4
        s1=sigma1/sigma14
        s2=sigma12/sigma14
        s3=sigma13/sigma14
        rlus=PYR(1)
        if(rlus <= s1)then
            ik1=321
            ik2=3222
!       3222 is the flavor code of Sigma+.
            ic=7
!       pion+ + p to K+ + Sigma+
        elseif(rlus > s1 .and. rlus <= s2)then
            ik1=111
            ik2=2224
!       2224 is the flavor code of Delta++.
            ic=155
!       pion+ + p to Delta++  +  pi0
        elseif(rlus > s2 .and. rlus <= s3)then
            ik1=213
            ik2=2212
!       213 is the Kf code of rho+.
            ic=157
!       pion+ + p to rho+ + p
        else
            ik1=211
            ik2=2214
!       2214 is the Kf code of Delta+.
            ic=156
!       pion+ + p to delta+ + pion+
        endif
        lc(3)=ik1
        lc(4)=ik2
        lc(5)=ic
        tw=sigma14/cspin/10.
        ioo=1


        return
        end



!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
        subroutine pip2(ss,lc,tw,ioo)
!!      A part of "piN_coll" to deal with pion- + p -> ...
        IMPLICIT DOUBLE PRECISION(A-H, O-Z)
        IMPLICIT INTEGER(I-N)
        INTEGER PYCOMP
!       Calculates particle production weight and fills up lc(i,3-5),tw(i).
!       tw : the ratio of cross section of (special inela.)/tot
        COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4)
        COMMON/PYCIDAT2/KFMAXT,NONT2,PARAM(100)
        common/sa10_h/csnn,cspin,cskn,cspipi,cspsn,cspsm,rcsit,ifram, &
         iabsb,iabsm,i_sigma_AQM,csspn,csspm
        common/count_h/isinel(2000)
        common/iloval/ilo1,ilo2,ilo3,ilo4,ilo5,ilo6,ilo7,ilo8,ilo9
        integer :: lc(6)


        ioo = 0
        if(isinel(11) == 0)then
            sigma1=0.
            goto 401
        endif
        the=PMAS(PYCOMP(321),1)+PMAS(PYCOMP(3112),1)
        sigma1=s0715(ss,ilo1,0,the)
!       Cross section of pion- + p to k+ + Sigma-.
!       Cross section is here in the unit of mb.
401     if(isinel(12) == 0)then
            sigma2=0.
            goto 402
        endif
        the=PMAS(PYCOMP(311),1)+PMAS(PYCOMP(3122),1)
        sigma2=s07122(ss,ilo2,0,the)
!       Cross section of pion- + p to K0 + Lambda0.
402     if(isinel(13) == 0)then
            sigma3=0.
            goto 403
        endif
        the=PMAS(PYCOMP(311),1)+PMAS(PYCOMP(3212),1)
        sigma3=s07123(ss,ilo3,0,the)
!       Cross section of pion- + p to k0 + Sigma0.
403     if(isinel(147) == 0)then
            sigma4=0.
            goto 203
        endif
!       the: threshold energy of a reaction
        the=PMAS(PYCOMP(1114),1)+PMAS(PYCOMP(211),1)
        sigma4=sdelta(ss,ilo4,0,the)
!       Cross section of pion- + p to Delta- + pi+.
203     if(isinel(148) == 0)then
            sigma5=0.
            goto 204
        endif
        the=PMAS(PYCOMP(113),1)+PMAS(PYCOMP(2112),1)
        sigma5=srho(ss,ilo5,0,the)
!       Cross section of pion- + p to rho0 + n.
204     if(isinel(149) == 0)then
            sigma6=0.
            goto 205
        endif
        the=PMAS(PYCOMP(-213),1)+PMAS(PYCOMP(2212),1)
        sigma6=srho(ss,ilo6,0,the)
!       Cross section of pion- + p to rho- + p.
205     if(isinel(150) == 0)then
            sigma7=0.
            goto 310
        endif
        the=PMAS(PYCOMP(-211),1)+PMAS(PYCOMP(2214),1)
        sigma7=sdelta(ss,ilo7,0,the)
!       Cross section of pion- + p to Delta+ + pion-.
310     if(isinel(151) == 0)then
            sigma8=0.
            goto 805
        endif
        the=PMAS(PYCOMP(111),1)+PMAS(PYCOMP(2114),1)
        sigma8=sdelta(ss,ilo8,0,the)
!       Cross section of pion- + p to Delta0 + pion0.
805     if(ilo1 == 0 .and. ilo2 == 0 .and. ilo3 == 0 &
            .and.ilo4 == 0 .and. ilo5 == 0 .and. ilo6 == 0 &
            .and.ilo7 == 0.and.ilo8 == 0) return
        if(sigma1 < 1D-6 .and. sigma2 < 1D-6 .and. sigma3 < 1D-6 &
            .and.sigma4 < 1D-6 .and. sigma5 < 1D-6 .and. &
            sigma6 < 1D-6.and. sigma7 < 1D-6 &
            .and.sigma8 < 1D-6) return
        sigma12=sigma1+sigma2
        sigma13=sigma12+sigma3
        sigma14=sigma13+sigma4
        sigma15=sigma14+sigma5
        sigma16=sigma15+sigma6
        sigma17=sigma16+sigma7
        sigma18=sigma17+sigma8
        s1=sigma1/sigma18
        s2=sigma12/sigma18
        s3=sigma13/sigma18
        s4=sigma14/sigma18
        s5=sigma15/sigma18
        s6=sigma16/sigma18
        s7=sigma17/sigma18
        rlus=PYR(1)
        if(rlus <= s1)then
            ik1=321
            ik2=3112
!       3112 is the flavor code of Sigma-
            ic=11
!       pion- + p to K+ + Sigma-
            goto 416
        endif
        if(rlus > s1 .and. rlus <= s2)then
            ik1=311
            ik2=3122
!       3122 is the Kf code of Lambda0
            ic=12
!       pion- + p to K0 + Lambda0
            goto 416
        endif
        if(rlus > s2 .and. rlus <= s3)then
            ik1=311
            ik2=3212
!       3212 is the KF code of Sigma0
            ic=13
!       pion- + p to K0 + Sigma0
            goto 416
        endif
        if(rlus > s3 .and. rlus <= s4)then
            ik1=211
            ik2=1114
!       1114 is the Kf code of Delta-
            ic=147
!       pion- + p to pi+ + Delta-
            goto 416
        endif
        if(rlus > s4 .and. rlus <= s5)then
            ik1=113
            ik2=2112
!       113 is the Kf code of rho0
            ic=148
!       pion- + p to rho0 + n
            goto 416
        endif
        if(rlus > s5 .and. rlus <= s6)then
            ik1=-213
            ik2=2212
!       -213 is the Kf code of rho-
            ic=149
!       pion- + p to rho- + p
            goto 416
        endif
        if(rlus > s6 .and. rlus <= s7)then
            ik1=-211
            ik2=2214
!       2214 is the Kf code of Delta+
            ic=150
!       pion- + p to Delta++pion-
            goto 416
        endif
        ik1=111
        ik2=2114
!       2114 is the Kf code of Delta0
        ic=151
!       pion- + p to Delta0+pion0

416     lc(3)=ik1
        lc(4)=ik2
        lc(5)=ic
        tw=sigma18/cspin/10.
        ioo=1


        return
        end



!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
        subroutine pip3(ss,lc,tw,ioo)
!!      A part of "piN_coll" to deal with pion0 + p to ...
        IMPLICIT DOUBLE PRECISION(A-H, O-Z)
        IMPLICIT INTEGER(I-N)
        INTEGER PYCOMP
!       Calculates particle production weight and fills up lc(i,3-5),tw(i).
!       tw : the ratio of cross section of (special inela.)/tot
        COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4)
        COMMON/PYCIDAT2/KFMAXT,NONT2,PARAM(100)
        SAVE /PYCIDAT2/
        common/sa10_h/csnn,cspin,cskn,cspipi,cspsn,cspsm,rcsit,ifram, &
         iabsb,iabsm,i_sigma_AQM,csspn,csspm
        common/count_h/isinel(2000)
        common/iloval/ilo1,ilo2,ilo3,ilo4,ilo5,ilo6,ilo7,ilo8,ilo9
        integer :: lc(6)


        ioo = 0
        if(isinel(15) == 0)then
            sigma1=0.
            goto 308
        endif
        the=PMAS(PYCOMP(321),1)+PMAS(PYCOMP(3212),1)
        sigma1=s2314(ss,ilo1,0,the)
!       Cross section of pion0 + p to K+ + Sigma0.
308     if(isinel(16) == 0)then
            sigma2=0.
            goto 239
        endif
        the=PMAS(PYCOMP(321),1)+PMAS(PYCOMP(3122),1)
        sigma2=s2317(ss,ilo2,0,the)
!       Cross section of pion0 + p to K+ + Lambda0.
239     if(isinel(163) == 0)then
            sigma3=0.
            goto 220
        endif
!       the: threshold energy of a reaction
        the=PMAS(PYCOMP(211),1)+PMAS(PYCOMP(2114),1)
        sigma3=sdelta(ss,ilo3,0,the)
!       Cross section of pion0 + p to Delta0 + pi+.
220     if(isinel(165) == 0)then
            sigma4=0.
            goto 240
        endif
        the=PMAS(PYCOMP(213),1)+PMAS(PYCOMP(2112),1)
        sigma4=srho(ss,ilo4,0,the)
!       Cross section of pion0 + p to rho+ + n.
240     if(isinel(164) == 0)then
            sigma5=0.
            goto 808
        endif
        the=PMAS(PYCOMP(-211),1)+PMAS(PYCOMP(2224),1)
        sigma5=sdelta(ss,ilo5,0,the)
!       Cross section of pion0 + p to Delta++ + pion-.
808     if(isinel(17) == 0)then
            sigma6=0.
            goto 815
        endif
        ilo6=1
        the=PMAS(PYCOMP(311),1)+PMAS(PYCOMP(3222),1)
        sigma6=s1724(ss,ilo6,0,the)
!       Cross section of pion0 + p to K0 + Sigma+.
815     if(isinel(166) == 0)then
            sigma7=0.
            goto 835
        endif
        ilo7=1
        the=PMAS(PYCOMP(113),1)+PMAS(PYCOMP(2212),1)
        sigma7=srho(ss,ilo7,0,the)
!       Cross section of pion0 + p to rho0 + p.
835     if(isinel(167) == 0)then
            sigma8=0.
            goto 845
        endif
        ilo8=1
        the=PMAS(PYCOMP(111),1)+PMAS(PYCOMP(2214),1)
        sigma8=sdelta(ss,ilo8,0,the)
!       Cross section of pion0 + p to pi0 + Delta+.
845     if(ilo1 == 0 .and. ilo2 == 0 .and. ilo3 == 0 &
            .and.ilo4 == 0.and.ilo5 == 0.and.ilo6 == 0 &
            .and.ilo7 == 0.and.ilo8 == 0) return
        if(sigma1 < 1D-6 .and. sigma2 < 1D-6 .and. sigma3 < 1D-6 &
            .and.sigma4 < 1D-6.and.sigma5 < 1D-6.and.sigma6 < 1D-6 &
            .and.sigma7 < 1D-6.and.sigma8 < 1D-6 ) return
        sigma12=sigma1+sigma2
        sigma13=sigma12+sigma3
        sigma14=sigma13+sigma4
        sigma15=sigma14+sigma5
        sigma16=sigma15+sigma6
        sigma17=sigma16+sigma7
        sigma18=sigma17+sigma8
        s1=sigma1/sigma18
        s2=sigma12/sigma18
        s3=sigma13/sigma18
        s4=sigma14/sigma18
        s5=sigma15/sigma18
        s6=sigma16/sigma18
        s7=sigma17/sigma18
        rlus=PYR(1)
        if(rlus <= s1)then
            ik1=321
            ik2=3212
            ic=15
!       3212 is the flavor code of Sigma0
!       pion0 + p to K+ + Sigma0
        elseif(rlus > s1 .and. rlus <= s2)then
            ik1=321
            ik2=3122
            ic=16
!       3122 is the flavor code of Lambda0
!       pion0 + p to K+ + Lambda0
        elseif(rlus > s2 .and. rlus <= s3)then
            ik1=211
            ik2=2114
!       2214 is the kf code of Delta+
        ic=163
!       pion0 + p to pi+ + Delta0
        elseif(rlus > s3 .and. rlus <= s4)then
            ik1=213
            ik2=2112
!       213 is the kf code of rho+
            ic=165
!       pion0 + p to rho+ + n
        elseif(rlus > s4 .and. rlus <= s5)then
            ik1=-211
            ik2=2224
!       2224 is the kf code of Delta++
            ic=164
        elseif(rlus > s5 .and. rlus <= s6)then
            ik1=311
            ik2=3222
!       3222 is the kf code of Sigma+
!       pion0 + p to K0 + Sigma+
            ic=17
        elseif(rlus > s6 .and. rlus <= s7)then
            ik1=113
            ik2=2212
!       113 is the kf code of rho0
            ic=166
!       pion0 + p to rho0 + p
        else
            ik1=111
            ik2=2214
!       2214 is the kf code of delta+
!       pion0 + p to pi0 + Delta+
            ic=167
        endif
        lc(3)=ik1
        lc(4)=ik2
        lc(5)=ic
        tw=sigma18/cspin/10.
        ioo=1


        return
        end



!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
        subroutine pin1(ss,lc,tw,ioo)
!!      A part of "piN_coll" to deal with pion+ + n to ...
        IMPLICIT DOUBLE PRECISION(A-H, O-Z)
        IMPLICIT INTEGER(I-N)
        INTEGER PYCOMP
!       Calculates particle production weight and fills up lc(i,3-5),tw(i).
!       tw : the ratio of cross section of (special inela.)/tot
        COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4)
        COMMON/PYCIDAT2/KFMAXT,NONT2,PARAM(100)
        SAVE /PYCIDAT2/
        common/sa10_h/csnn,cspin,cskn,cspipi,cspsn,cspsm,rcsit,ifram, &
         iabsb,iabsm,i_sigma_AQM,csspn,csspm
        common/count_h/isinel(2000)
        common/iloval/ilo1,ilo2,ilo3,ilo4,ilo5,ilo6,ilo7,ilo8,ilo9
        integer :: lc(6)


        ioo = 0
        if(isinel(8) == 0)then
            sigma1=0.
            goto 306
        endif
        the=PMAS(PYCOMP(321),1)+PMAS(PYCOMP(3212),1)
        sigma1=s1724(ss,ilo1,0,the)
!       Cross section of pion+ + n to K+ + Sigma0.
306     if(isinel(9) == 0)then
            sigma2=0.
            goto 207
        endif
        the=PMAS(PYCOMP(321),1)+PMAS(PYCOMP(3122),1)
        sigma2=s1727(ss,ilo2,0,the)
!       Cross section of pion+ + n to K+ + Lambda0
207     if(isinel(158) == 0)then
            sigma3=0.
            goto 208
        endif
!       the: threshold energy of a reaction
        the=PMAS(PYCOMP(-211),1)+PMAS(PYCOMP(2224),1)
        sigma3=sdelta(ss,ilo3,0,the)
!       Cross section of pion+ + n to Delta++ + pi-.
208     if(isinel(161) == 0)then
            sigma4=0.
            goto 209
        endif
        the=PMAS(PYCOMP(113),1)+PMAS(PYCOMP(2212),1)
        sigma4=srho(ss,ilo4,0,the)
!       Cross section of pion+ + n to rho0 + p.
209     if(isinel(162) == 0)then
            sigma5=0.
            goto 210
        endif
        the=PMAS(PYCOMP(213),1)+PMAS(PYCOMP(2112),1)
        sigma5=srho(ss,ilo5,0,the)
!       Cross section of pion+ + n to rho+ + n.
210     if(isinel(159) == 0)then
            sigma6=0.
            goto 806
        endif
        the=PMAS(PYCOMP(211),1)+PMAS(PYCOMP(2114),1)
        sigma6=sdelta(ss,ilo6,0,the)
!       Cross section of pion+ + n to Delta0 + pion+.
806     if(isinel(10) == 0)then
            sigma7=0.
            goto 814
        endif
        ilo7=1
        the=PMAS(PYCOMP(311),1)+PMAS(PYCOMP(3222),1)
        sigma7=s1724(ss,ilo7,0,the)
!       Cross section of pion+ + n to K0 + Sigma+.
814     if(isinel(160) == 0)then
            sigma8=0.
            goto 818
        endif
        ilo8=1
        the=PMAS(PYCOMP(111),1)+PMAS(PYCOMP(2214),1)
        sigma8=sdelta(ss,ilo8,0,the)
!       Cross section of pion+ + n to pi0 + Delta+.
818     if(ilo1 == 0 .and. ilo2 == 0 .and. ilo3 == 0 &
            .and.ilo4 == 0 .and. ilo5 == 0.and.ilo6 == 0 &
            .and.ilo7 == 0.and.ilo8 == 0) return
        if(sigma1 < 1D-6 .and. sigma2 < 1D-6 .and. sigma3 < 1D-6 &
            .and.sigma4 < 1D-6 .and. sigma5 < 1D-6.and.  &
            sigma6 < 1D-6 &
            .and.sigma7 < 1D-6.and.sigma8 < 1D-6) return
        sigma12=sigma1+sigma2
        sigma13=sigma12+sigma3
        sigma14=sigma13+sigma4
        sigma15=sigma14+sigma5
        sigma16=sigma15+sigma6
        sigma17=sigma16+sigma7
        sigma18=sigma17+sigma8
        s1=sigma1/sigma18
        s2=sigma12/sigma18
        s3=sigma13/sigma18
        s4=sigma14/sigma18
        s5=sigma15/sigma18
        s6=sigma16/sigma18
        s7=sigma17/sigma18
        rlus=PYR(1)
        if(rlus <= s1)then
            ik1=321
            ik2=3212
!       3212 is the flavor code of Sigma0
            ic=8
!       pion+ + n to k+ + Sigma0
        elseif(rlus > s1 .and. rlus <= s2)then
            ik1=321
            ik2=3122
!       3122 is the flavor code of Lambda0
            ic=9
!       pion+ + n to K+ + Lambda0
        elseif(rlus > s2 .and. rlus <= s3)then
            ik1=-211
            ik2=2224
!       2224 is the Kf code of Delta++
            ic=158
!       pion+ + n to pi- + Delta++
        elseif(rlus > s3 .and. rlus <= s4)then
            ik1=113
            ik2=2212
!       113 is the Kf code of rho0
            ic=161
!       pion+ + n to rho0 + p
        elseif(rlus > s4 .and. rlus <= s5)then
            ik1=213
            ik2=2112
!       213 is the Kf code of rho+
            ic=162
!       pion+ + n to rho+ + n
        elseif(rlus > s5 .and. rlus <= s6)then
            ik1=211
            ik2=2114
!       2114 is the Kf code of Delta0
            ic=159
        elseif(rlus > s6 .and. rlus <= s7)then
            ik1=311
            ik2=3222
!       3222 is the Kf code of Sigma+
            ic=10
!       pion+ + n to k0 + sigma+
        else
            ik1=111
            ik2=2214
!       2214 is the Kf code of Delta+
            ic=160
!       pion+ + n to pi0 + Delta+
        endif
        lc(3)=ik1
        lc(4)=ik2
        lc(5)=ic
        tw=sigma18/cspin/10.
        ioo=1


        return
        end



!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
        subroutine pin2(ss,lc,tw,ioo)
!!      A part of "piN_coll" to deat with pion- + n -> ...
        IMPLICIT DOUBLE PRECISION(A-H, O-Z)
        IMPLICIT INTEGER(I-N)
        INTEGER PYCOMP
!       Calculates particle production weight and fills up lc(i,3-5),tw(i).
!       tw : the ratio of cross section of (special inela.)/tot
        COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4)
        COMMON/PYCIDAT2/KFMAXT,NONT2,PARAM(100)
        SAVE /PYCIDAT2/
        common/sa10_h/csnn,cspin,cskn,cspipi,cspsn,cspsm,rcsit,ifram, &
         iabsb,iabsm,i_sigma_AQM,csspn,csspm
        common/count_h/isinel(2000)
        common/iloval/ilo1,ilo2,ilo3,ilo4,ilo5,ilo6,ilo7,ilo8,ilo9
        integer :: lc(6)


        ioo = 0
        if(isinel(152) == 0)then
            sigma1=0.
            goto 222
        endif
        the=PMAS(PYCOMP(111),1)+PMAS(PYCOMP(1114),1)
        sigma1=sdelta(ss,ilo1,0,the)
!       Cross section of pion- + n to Delta- + pi0
222     if(isinel(153) == 0)then
            sigma2=0.
            goto 223
        endif
        the=PMAS(PYCOMP(-213),1)+PMAS(PYCOMP(2112),1)
        sigma2=srho(ss,ilo2,0,the)
!       Cross section of pion- + n to rho- + n.
223     if(isinel(154) == 0)then
            sigma3=0.
            goto 228
        endif
        the=PMAS(PYCOMP(-211),1)+PMAS(PYCOMP(2114),1)
        sigma3=sdelta(ss,ilo3,0,the)
!       Cross section of pion- + n to Delta0 + pion-.
228     if(isinel(14) == 0)then
            sigma4=0.
            goto 818
        endif
        ilo4=1
        the=PMAS(PYCOMP(311),1)+PMAS(PYCOMP(3112),1)
        sigma4=s1724(ss,ilo4,0,the)
!       Cross section of pion- + n to k0 + Sigma-.
818     if(ilo1 == 0.and.ilo2 == 0.and.ilo3 == 0 &
            .and.ilo4 == 0) return
        if(sigma1 < 1D-6 .and. sigma2 < 1D-6.and. &
            sigma3 < 1D-6.and. sigma4 < 1D-6) return
        sigm12=sigma1+sigma2
        sigm13=sigm12+sigma3
        sigm14=sigm13+sigma4
        s1=sigma1/sigm14
        s2=sigm12/sigm14
        s3=sigm13/sigm14
        rlu1=PYR(1)
        if(rlu1 <= s1)then
            ik1=111
            ik2=1114
            ic=152
!       pion- + n to Delta-  +  pi0
        elseif(rlu1 > s1 .and. rlu1 <= s2)then
            ik1=-213
            ik2=2112
            ic=153
!       cross section of pion- + n to rho- + n
        elseif(rlu1 > s2 .and. rlu1 <= s3)then
            ik1=-211
            ik2=2114
!       Cross section of pion- + n to Delta0 + pion-.
            ic=154
        else
            ik1=311
            ik2=3112
            ic=14
!       Cross section of pion- + n to K0 + Sigma-.
        endif
        lc(3)=ik1
        lc(4)=ik2
        lc(5)=ic
        tw=sigm14/cspin/10.
        ioo=1


        return
        end



!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
        subroutine pin3(ss,lc,tw,ioo)
!!      A part of "piN_coll" to deal with pion0 + n to ...
        IMPLICIT DOUBLE PRECISION(A-H, O-Z)
        IMPLICIT INTEGER(I-N)
        INTEGER PYCOMP
!       Calculates particle production weight and fills up lc(i,3-5),tw(i).
!       tw : the ratio of cross section of (special inela.)/tot
        COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4)
        COMMON/PYCIDAT2/KFMAXT,NONT2,PARAM(100)
        SAVE /PYCIDAT2/
        common/sa10_h/csnn,cspin,cskn,cspipi,cspsn,cspsm,rcsit,ifram, &
         iabsb,iabsm,i_sigma_AQM,csspn,csspm
        common/count_h/isinel(2000)
        common/iloval/ilo1,ilo2,ilo3,ilo4,ilo5,ilo6,ilo7,ilo8,ilo9
        integer :: lc(6)


        ioo = 0
        if(isinel(172) == 0)then
            sigma1=0.
            goto 216
        endif
        ilo1=1
        the=PMAS(PYCOMP(-213),1)+PMAS(PYCOMP(2212),1)
        sigma1=srho(ss,ilo1,0,the)
!       Cross section of pion0 + n to rho- + p.
216     if(isinel(168) == 0)then
            sigma2=0.
            goto 217
        endif
!       the: threshold energy of a reaction
        the=PMAS(PYCOMP(-211),1)+PMAS(PYCOMP(2214),1)
        sigma2=sdelta(ss,ilo2,0,the)
!       Cross section of pion0 + n to Delta+ + pi-.
217     if(isinel(171) == 0)then
            sigma3=0.
            goto 218
        endif
        the=PMAS(PYCOMP(113),1)+PMAS(PYCOMP(2112),1)
        sigma3=srho(ss,ilo3,0,the)
!       Cross section of pion0 + n to rho0 + n.
218     if(isinel(169) == 0)then
            sigma4=0.
            goto 807
        endif
        the=PMAS(PYCOMP(211),1)+PMAS(PYCOMP(1114),1)
        sigma4=sdelta(ss,ilo4,0,the)
!       Cross section of pion0 + n to Delta- + pion+.
807     if(isinel(19) == 0)then
            sigma5=0.
            goto 811
        endif
        ilo5=1
        the=PMAS(PYCOMP(311),1)+PMAS(PYCOMP(3122),1)
        sigma5=s2317(ss,ilo5,0,the)
!       Cross section of pion0 + n to K0 + Lambda0 is assumed
!        to be cross section of pion0 + p to K+ + Lambda0.
811     if(isinel(18) == 0)then
            sigma6=0.
            goto 816
        endif
        ilo6=1
        the=PMAS(PYCOMP(321),1)+PMAS(PYCOMP(3112),1)
        sigma6=s2325(ss,ilo6,0,the)
!       Cross section of pion0 + n to K+ + Sigma-.
816     if(isinel(20) == 0)then
            sigma7=0.
            goto 817
        endif
        ilo7=1
        the=PMAS(PYCOMP(311),1)+PMAS(PYCOMP(3212),1)
        sigma7=s1724(ss,ilo7,0,the)
!       Cross section of pion0 + n to K0 + Sigma0.
817     if(isinel(170) == 0)then
            sigma8=0.
            goto 827
        endif
        the=PMAS(PYCOMP(111),1)+PMAS(PYCOMP(2114),1)
        sigma8=sdelta(ss,ilo8,0,the)
!       Cross section of pion0 + n to Delta0 + pion0.
827     if(ilo1 == 0 .and. ilo2 == 0 .and. ilo3 == 0.and. &
            ilo4 == 0.and. ilo5 == 0 &
            .and. ilo6 == 0 .and. ilo7 == 0 .and. ilo8 == 0) return
        if(sigma1 < 1D-6 .and. sigma2 < 1D-6 .and. sigma3 < 1D-6 &
            .and. sigma4 < 1D-6.and. sigma5 < 1D-6 &
            .and. sigma6 < 1D-6.and. sigma7 < 1D-6 &
            .and. sigma8 < 1D-6) return
        sigma12=sigma1+sigma2
        sigma13=sigma12+sigma3
        sigma14=sigma13+sigma4
        sigma15=sigma14+sigma5
        sigma16=sigma15+sigma6
        sigma17=sigma16+sigma7
        sigma18=sigma17+sigma8
        s1=sigma1/sigma18
        s2=sigma12/sigma18
        s3=sigma13/sigma18
        s4=sigma14/sigma18
        s5=sigma15/sigma18
        s6=sigma16/sigma18
        s7=sigma17/sigma18
        rlus=PYR(1)
        if(rlus <= s1)then
            ik1=-213
            ik2=2212
!       -213 is the flavor code of rho-
            ic=172
!       pion0 + n to p + rho-
        elseif(rlus > s1 .and. rlus <= s2)then
            ik1=-211
            ik2=2214
!       2214 is the flavor code of Delta+
            ic=168
!       pion0 + n to Delta+ + pi-
        elseif(rlus > s2 .and. rlus <= s3)then
            ik1=113
            ik2=2112
!       113 is the kf code of rho
            ic=171
!       pion0 + n to rho  +  n
        elseif(rlus > s3 .and. rlus <= s4)then
            ik1=211
            ik2=1114
!       1114 is the kf code of Delta-
            ic=169
        elseif(rlus > s4 .and. rlus <= s5)then
            ik1=311
            ik2=3122
!       3122 is the kf code of Lambda0
!       pion0 + n to K0 + Lambda0
            ic=19
        elseif(rlus > s5 .and. rlus <= s6)then
            ik1=321
            ik2=3112
!       3112 is the kf code of Sigma-
            ic=18
        elseif(rlus > s6 .and. rlus <= s7)then
!       pion0 + n to K+ + Sigma-
            ik1=311
            ik2=3212
!       3212 is the kf code of Sigma0
            ic=20
!       pion0 + n to K0 + Sigma0
        else
            ik1=111
            ik2=2114
!       2114 is the kf code of Delta0
            ic=170
!       pion0 + n to pi0 + Delta0
        endif
        lc(3)=ik1
        lc(4)=ik2
        lc(5)=ic
        tw=sigma18/cspin/10.
        ioo=1


        return
        end



!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
        subroutine pi_pbar1(ss,lc,tw,ioo)
!!      A part of "piN_coll" to deal with pion- + pbar to ...
        IMPLICIT DOUBLE PRECISION(A-H, O-Z)
        IMPLICIT INTEGER(I-N)
        INTEGER PYCOMP
!       Calculates particle production weight and fills up lc(i,3-5),tw(i).
!       tw : the ratio of cross section of (special inela.)/tot
        COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4)
        COMMON/PYCIDAT2/KFMAXT,NONT2,PARAM(100)
        SAVE /PYCIDAT2/
        common/sa10_h/csnn,cspin,cskn,cspipi,cspsn,cspsm,rcsit,ifram, &
         iabsb,iabsm,i_sigma_AQM,csspn,csspm
        common/count_h/isinel(2000)
        common/iloval/ilo1,ilo2,ilo3,ilo4,ilo5,ilo6,ilo7,ilo8,ilo9
        integer :: lc(6)


        ioo = 0
        if(isinel(25) == 0)then
            sigma1=0.
            goto 212
        endif
        the=PMAS(PYCOMP(-321),1)+PMAS(PYCOMP(-3222),1)
        sigma1=s1713(ss,ilo1,0,the)
!       Cross section of pion- + pba to K- + Sigma+ba.
212     if(isinel(505) == 0)then
            sigma2=0.
            goto 213
        endif
!       the: threshold energy of a reaction
        the=PMAS(PYCOMP(111),1)+PMAS(PYCOMP(-2224),1)
        sigma2=sdelta(ss,ilo2,0,the)
!       Cross section of pion- + pba to Delta++ba + pi0.
213     if(isinel(507) == 0)then
            sigma3=0.
            goto 214
        endif
        the=PMAS(PYCOMP(-213),1)+PMAS(PYCOMP(-2212),1)
        sigma3=srho(ss,ilo3,0,the)
!       Cross section of pion- + pba to rho- + pba.
214     if(isinel(506) == 0)then
            sigma4=0.
            goto 804
        endif
        the=PMAS(PYCOMP(-211),1)+PMAS(PYCOMP(-2214),1)
        sigma4=sdelta(ss,ilo4,0,the)
!       Cross section of pion- + pba to Delta+ba + pion-.
804     if(ilo1 == 0 .and. ilo2 == 0 .and. ilo3 == 0 &
            .and. ilo4 == 0) return
        if(sigma1 < 1D-6 .and. sigma2 < 1D-6 .and. sigma3 < 1D-6 &
            .and. sigma4 < 1D-6 ) return
        sigma12=sigma1+sigma2
        sigma13=sigma12+sigma3
        sigma14=sigma13+sigma4
        s1=sigma1/sigma14
        s2=sigma12/sigma14
        s3=sigma13/sigma14
        rlus=PYR(1)
        if(rlus <= s1)then
            ik1=-321
            ik2=-3222
!       -3222 is the flavor code of Sigma+ba.
            ic=25
!       pion- + pba to K- + Sigma+ba
        elseif(rlus > s1 .and. rlus <= s2)then
            ik1=111
            ik2=-2224
!       -2224 is the flavor code of Delta++ba.
            ic=505
!       pion- + pba to Delta++ba + pi0
        elseif(rlus > s2 .and. rlus <= s3)then
            ik1=-213
            ik2=-2212
!       -213 is the Kf code of rho-.
            ic=507
!       pion- + pba to pi- + pba
        else
            ik1=-211
            ik2=-2214
!       -2214 is the Kf code of Delta+ba.
            ic=506
!       pion- + pba to Delta+ba + pion-
        endif
        lc(3)=ik1
        lc(4)=ik2
        lc(5)=ic
        tw=sigma14/cspin/10.
        ioo=1


        return
        end



!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
        subroutine pi_pbar2(ss,lc,tw,ioo)
!!      A part of "prod" to deal with pion+ + pbar -> ...
        IMPLICIT DOUBLE PRECISION(A-H, O-Z)
        IMPLICIT INTEGER(I-N)
        INTEGER PYCOMP
!       Calculates particle production weight and fills up lc(i,3-5),tw(i).
!       tw : the ratio of cross section of (special inela.)/tot
        COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4)
        COMMON/PYCIDAT2/KFMAXT,NONT2,PARAM(100)
        common/sa10_h/csnn,cspin,cskn,cspipi,cspsn,cspsm,rcsit,ifram, &
         iabsb,iabsm,i_sigma_AQM,csspn,csspm
        common/count_h/isinel(2000)
        common/iloval/ilo1,ilo2,ilo3,ilo4,ilo5,ilo6,ilo7,ilo8,ilo9
        integer :: lc(6)


        ioo = 0
        if(isinel(23) == 0)then
            sigma1=0.
            goto 401
        endif
        the=PMAS(PYCOMP(-321),1)+PMAS(PYCOMP(-3112),1)
        sigma1=s0715(ss,ilo1,0,the)
!       Cross section of pion+ + pba to K- + Sigma-ba.
!       Cross section is here in the unit of mb.
401     if(isinel(21) == 0)then
            sigma2=0.
            goto 402
        endif
        the=PMAS(PYCOMP(-311),1)+PMAS(PYCOMP(-3122),1)
        sigma2=s07122(ss,ilo2,0,the)
!       Cross section of pion+ + pba to K0ba + Lambda0ba.
402     if(isinel(22) == 0)then
            sigma3=0.
            goto 403
        endif
        the=PMAS(PYCOMP(-311),1)+PMAS(PYCOMP(-3212),1)
        sigma3=s07123(ss,ilo3,0,the)
!       Cross section of pion+ + pba to K0ba + Sigma0ba.
403     if(isinel(497) == 0)then
            sigma4=0.
            goto 203
        endif
!       the: threshold energy of a reaction
        the=PMAS(PYCOMP(-1114),1)+PMAS(PYCOMP(-211),1)
        sigma4=sdelta(ss,ilo4,0,the)
!       Cross section of pion+ + pba to Delta-ba + pi-.
203     if(isinel(498) == 0)then
            sigma5=0.
            goto 204
        endif
        the=PMAS(PYCOMP(113),1)+PMAS(PYCOMP(-2112),1)
        sigma5=srho(ss,ilo5,0,the)
!       Cross section of pion+ + pba to rho0 + nba.
204     if(isinel(499) == 0)then
            sigma6=0.
            goto 205
        endif
        the=PMAS(PYCOMP(213),1)+PMAS(PYCOMP(-2212),1)
        sigma6=srho(ss,ilo6,0,the)
!       Cross section of pion+ + pba to rho+ + pba.
205     if(isinel(500) == 0)then
            sigma7=0.
            goto 310
        endif
        the=PMAS(PYCOMP(211),1)+PMAS(PYCOMP(-2214),1)
        sigma7=sdelta(ss,ilo7,0,the)
!       Cross section of pion+ + pba to Delta+ba + pion+.
310     if(isinel(501) == 0)then
            sigma8=0.
            goto 805
        endif
        the=PMAS(PYCOMP(111),1)+PMAS(PYCOMP(-2114),1)
        sigma8=sdelta(ss,ilo8,0,the)
!       cross section of pion+ + pba to Delta0ba + pion0
805     if(ilo1 == 0 .and. ilo2 == 0 .and. ilo3 == 0 &
            .and.ilo4 == 0 .and. ilo5 == 0 .and. ilo6 == 0 &
            .and.ilo7 == 0.and.ilo8 == 0) return
        if(sigma1 < 1D-6 .and. sigma2 < 1D-6 .and. sigma3 < 1D-6 &
            .and.sigma4 < 1D-6 .and. sigma5 < 1D-6 .and. &
            sigma6 < 1D-6.and. sigma7 < 1D-6 &
            .and.sigma8 < 1D-6) return
        sigma12=sigma1+sigma2
        sigma13=sigma12+sigma3
        sigma14=sigma13+sigma4
        sigma15=sigma14+sigma5
        sigma16=sigma15+sigma6
        sigma17=sigma16+sigma7
        sigma18=sigma17+sigma8
        s1=sigma1/sigma18
        s2=sigma12/sigma18
        s3=sigma13/sigma18
        s4=sigma14/sigma18
        s5=sigma15/sigma18
        s6=sigma16/sigma18
        s7=sigma17/sigma18
        rlus=PYR(1)
        if(rlus <= s1)then
            ik1=-321
            ik2=-3112
!       -3112 is the flavor code of Sigma-ba
            ic=23
!       pion+ + pba to K- + Sigma-ba
            goto 416
        endif
        if(rlus > s1 .and. rlus <= s2)then
            ik1=-311
            ik2=-3122
!       -3122 is the Kf code of Lambda0ba
            ic=21
!       pion+ + pba to K0ba + Lambda0ba
            goto 416
        endif
        if(rlus > s2 .and. rlus <= s3)then
            ik1=-311
            ik2=-3212
!       -3212 is the KF code of Sigma0ba
            ic=22
!       pion+ + pba to K0ba + Sigma0ba
            goto 416
        endif
        if(rlus > s3 .and. rlus <= s4)then
            ik1=-211
            ik2=-1114
!       -1114 is the Kf code of Delta-ba
            ic=497
!       pion+ + pba to pi- + Delta-ba
            goto 416
        endif
        if(rlus > s4 .and. rlus <= s5)then
            ik1=113
            ik2=-2112
!       113 is the Kf code of rho0
            ic=498
!       pion+ + pba to rho0 + nba
            goto 416
        endif
        if(rlus > s5 .and. rlus <= s6)then
            ik1=213
            ik2=-2212
!       213 is the Kf code of rho+
            ic=499
!       pion+ + pba to rho+ + pba
            goto 416
        endif
        if(rlus > s6 .and. rlus <= s7)then
            ik1=211
            ik2=-2214
!       -2214 is the Kf code of Delta+ba
            ic=500
!       pion+ + pba to Delta+ba + pion+
            goto 416
        endif
        ik1=111
        ik2=-2114
!       -2114 is the Kf code of Delta0ba
        ic=501
!       pion+ + pba to Delta0ba + pion0

416     lc(3)=ik1
        lc(4)=ik2
        lc(5)=ic
        tw=sigma18/cspin/10.
        ioo=1


        return
        end



!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
        subroutine pi_pbar3(ss,lc,tw,ioo)
!!      A part of "piN_coll" to deal with pion0 + pba to ...
        IMPLICIT DOUBLE PRECISION(A-H, O-Z)
        IMPLICIT INTEGER(I-N)
        INTEGER PYCOMP
!       Calculates particle production weight and fills up lc(i,3-5),tw(i).
!       tw : the ratio of cross section of (special inela.)/tot
        COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4)
        COMMON/PYCIDAT2/KFMAXT,NONT2,PARAM(100)
        SAVE /PYCIDAT2/
        common/sa10_h/csnn,cspin,cskn,cspipi,cspsn,cspsm,rcsit,ifram, &
         iabsb,iabsm,i_sigma_AQM,csspn,csspm
        common/count_h/isinel(2000)
        common/iloval/ilo1,ilo2,ilo3,ilo4,ilo5,ilo6,ilo7,ilo8,ilo9
        integer :: lc(6)


        ioo = 0
        if(isinel(30) == 0)then
            sigma1=0.
            goto 308
        endif
        the=PMAS(PYCOMP(-321),1)+PMAS(PYCOMP(-3212),1)
        sigma1=s2314(ss,ilo1,0,the)
!       Cross section of pion0 + pba to K- + Sigma0ba.
308     if(isinel(29) == 0)then
            sigma2=0.
            goto 239
        endif
        the=PMAS(PYCOMP(-321),1)+PMAS(PYCOMP(-3122),1)
        sigma2=s2317(ss,ilo2,0,the)
!       Cross section of pion0 + pba to K- + Lambda0ba.
239     if(isinel(513) == 0)then
            sigma3=0.
            goto 220
        endif
!       the: threshold energy of a reaction
        the=PMAS(PYCOMP(-211),1)+PMAS(PYCOMP(-2114),1)
        sigma3=sdelta(ss,ilo3,0,the)
!       Cross section of pion0 + pba to Delta0ba + pi-.
220     if(isinel(515) == 0)then
            sigma4=0.
            goto 240
        endif
        the=PMAS(PYCOMP(-213),1)+PMAS(PYCOMP(-2112),1)
        sigma4=srho(ss,ilo4,0,the)
!       Cross section of pion0 + pba to rho- + nba.
240     if(isinel(514) == 0)then
            sigma5=0.
            goto 808
        endif
        the=PMAS(PYCOMP(211),1)+PMAS(PYCOMP(-2224),1)
        sigma5=sdelta(ss,ilo5,0,the)
!       Cross section of pion0 + pba to Delta++ba + pion+.
808     if(isinel(31) == 0)then
            sigma6=0.
            goto 815
        endif
        ilo6=1
        the=PMAS(PYCOMP(-311),1)+PMAS(PYCOMP(-3222),1)
        sigma6=s1724(ss,ilo6,0,the)
!       Cross section of pion0 + pba to K0ba + Sigma+ba.
815     if(isinel(516) == 0)then
            sigma7=0.
            goto 835
        endif
        ilo7=1
        the=PMAS(PYCOMP(113),1)+PMAS(PYCOMP(-2212),1)
        sigma7=srho(ss,ilo7,0,the)
!       Cross section of pion0 + pba to rho0 + pba.
835     if(isinel(517) == 0)then
            sigma8=0.
            goto 845
        endif
        ilo8=1
        the=PMAS(PYCOMP(111),1)+PMAS(PYCOMP(-2214),1)
        sigma8=sdelta(ss,ilo8,0,the)
!       Cross section of pion0 + pba to pi0 + Delta+ba.
845     if(ilo1 == 0 .and. ilo2 == 0 .and. ilo3 == 0 &
            .and.ilo4 == 0.and.ilo5 == 0.and.ilo6 == 0 &
            .and.ilo7 == 0.and.ilo8 == 0) return
        if(sigma1 < 1D-6 .and. sigma2 < 1D-6 .and. sigma3 < 1D-6 &
            .and.sigma4 < 1D-6.and.sigma5 < 1D-6.and.sigma6 < 1D-6 &
            .and.sigma7 < 1D-6.and.sigma8 < 1D-6 ) return
        sigma12=sigma1+sigma2
        sigma13=sigma12+sigma3
        sigma14=sigma13+sigma4
        sigma15=sigma14+sigma5
        sigma16=sigma15+sigma6
        sigma17=sigma16+sigma7
        sigma18=sigma17+sigma8
        s1=sigma1/sigma18
        s2=sigma12/sigma18
        s3=sigma13/sigma18
        s4=sigma14/sigma18
        s5=sigma15/sigma18
        s6=sigma16/sigma18
        s7=sigma17/sigma18
        rlus=PYR(1)
        if(rlus <= s1)then
            ik1=-321
            ik2=-3212
            ic=30
!       -3212 is the flavor code of Sigma0ba
!       pion0 + pba to K- + Sigma0ba
        elseif(rlus > s1 .and. rlus <= s2)then
            ik1=-321
            ik2=-3122
            ic=29
!       -3122 is the flavor code of Lambda0ba
!       pion0 + pba to K- + Lambda0ba
        elseif(rlus > s2 .and. rlus <= s3)then
            ik1=-211
            ik2=-2114
!       -2214 is the kf code of Delta+ba
            ic=513
!       pion0 + pba to pi- + Delta0ba
        elseif(rlus > s3 .and. rlus <= s4)then
            ik1=-213
            ik2=-2112
!       -213 is the kf code of rho-
            ic=515
!       pion0 + pba to rho- + nba
        elseif(rlus > s4 .and. rlus <= s5)then
            ik1=211
            ik2=-2224
!       -2224 is the kf code of Delta++ba
            ic=514
        elseif(rlus > s5 .and. rlus <= s6)then
            ik1=-311
            ik2=-3222
!       -3222 is the kf code of Sigma+ba
            ic=31
!       pion0 + pba to K0ba + Sigma+ba
        elseif(rlus > s6 .and. rlus <= s7)then
            ik1=113
            ik2=-2212
!       113 is the kf code of rho0
            ic=516
!       pion0 + pba to rho0 + pba
        else
            ik1=111
            ik2=-2214
!       -2214 is the kf code of Delta+ba
            ic=517
!       pion0 + p to pi0 + Delta+
        endif
        lc(3)=ik1
        lc(4)=ik2
        lc(5)=ic
        tw=sigma18/cspin/10.
        ioo=1


        return
        end



!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
        subroutine pi_nbar1(ss,lc,tw,ioo)
!!      A part of "piN_coll" to deal with pion- + nba to ...
        IMPLICIT DOUBLE PRECISION(A-H, O-Z)
        IMPLICIT INTEGER(I-N)
        INTEGER PYCOMP
!       Calculates particle production weight and fills up lc(i,3-5),tw(i).
!       tw : the ratio of cross section of (special inela.)/tot
        COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4)
        COMMON/PYCIDAT2/KFMAXT,NONT2,PARAM(100)
        SAVE /PYCIDAT2/
        common/sa10_h/csnn,cspin,cskn,cspipi,cspsn,cspsm,rcsit,ifram, &
         iabsb,iabsm,i_sigma_AQM,csspn,csspm
        common/count_h/isinel(2000)
        common/iloval/ilo1,ilo2,ilo3,ilo4,ilo5,ilo6,ilo7,ilo8,ilo9
        integer :: lc(6)


        ioo = 0
        if(isinel(27) == 0)then
            sigma1=0.
            goto 306
        endif
        the=PMAS(PYCOMP(-321),1)+PMAS(PYCOMP(-3212),1)
        sigma1=s1724(ss,ilo1,0,the)
!       Cross section of pion+ + nba to K- + Sigma0ba.
306     if(isinel(26) == 0)then
            sigma2=0.
            goto 207
        endif
        the=PMAS(PYCOMP(-321),1)+PMAS(PYCOMP(-3122),1)
        sigma2=s1727(ss,ilo2,0,the)
!       Cross section of pion+ + nba to K- + Lambda0ba
207     if(isinel(508) == 0)then
            sigma3=0.
            goto 208
        endif
!       the: threshold energy of a reaction
        the=PMAS(PYCOMP(211),1)+PMAS(PYCOMP(-2224),1)
        sigma3=sdelta(ss,ilo3,0,the)
!       Cross section of pion- + nba to Delta++ba + pi+.
208     if(isinel(511) == 0)then
            sigma4=0.
            goto 209
        endif
        the=PMAS(PYCOMP(113),1)+PMAS(PYCOMP(-2212),1)
        sigma4=srho(ss,ilo4,0,the)
!       Cross section of pion+ + nba to rho0 + pba.
209     if(isinel(512) == 0)then
            sigma5=0.
            goto 210
        endif
        the=PMAS(PYCOMP(-213),1)+PMAS(PYCOMP(-2112),1)
        sigma5=srho(ss,ilo5,0,the)
!       Cross section of pion- + nba to rho- + nba.
210     if(isinel(509) == 0)then
            sigma6=0.
            goto 806
        endif
        the=PMAS(PYCOMP(-211),1)+PMAS(PYCOMP(-2114),1)
        sigma6=sdelta(ss,ilo6,0,the)
!       Cross section of pion- + nba to Delta0ba + pion-.
806     if(isinel(28) == 0)then
            sigma7=0.
            goto 814
        endif
        ilo7=1
        the=PMAS(PYCOMP(-311),1)+PMAS(PYCOMP(-3222),1)
        sigma7=s1724(ss,ilo7,0,the)
!       Cross section of pion- + nba to K0ba + Sigma+ba.
814     if(isinel(510) == 0)then
            sigma8=0.
            goto 818
        endif
        ilo8=1
        the=PMAS(PYCOMP(111),1)+PMAS(PYCOMP(-2214),1)
        sigma8=sdelta(ss,ilo8,0,the)
!       Cross section of pion- + nba to pi0 + Delta+ba.
818     if(ilo1 == 0 .and. ilo2 == 0 .and. ilo3 == 0 &
            .and.ilo4 == 0 .and. ilo5 == 0.and.ilo6 == 0 &
            .and.ilo7 == 0.and.ilo8 == 0) return
        if(sigma1 < 1D-6 .and. sigma2 < 1D-6 .and. sigma3 < 1D-6 &
            .and.sigma4 < 1D-6 .and. sigma5 < 1D-6.and.  &
            sigma6 < 1D-6 &
            .and.sigma7 < 1D-6.and.sigma8 < 1D-6) return
        sigma12=sigma1+sigma2
        sigma13=sigma12+sigma3
        sigma14=sigma13+sigma4
        sigma15=sigma14+sigma5
        sigma16=sigma15+sigma6
        sigma17=sigma16+sigma7
        sigma18=sigma17+sigma8
        s1=sigma1/sigma18
        s2=sigma12/sigma18
        s3=sigma13/sigma18
        s4=sigma14/sigma18
        s5=sigma15/sigma18
        s6=sigma16/sigma18
        s7=sigma17/sigma18
        rlus=PYR(1)
        if(rlus <= s1)then
            ik1=-321
            ik2=-3212
!       -3212 is the flavor code of Sigma0ba
            ic=27
!       pion- + nba to K- + Sigma0ba
        elseif(rlus > s1 .and. rlus <= s2)then
            ik1=-321
            ik2=-3122
!       -3122 is the flavor code of Lambda0ba
            ic=26
!       pion- + nba to K- + Lambda0ba
        elseif(rlus > s2 .and. rlus <= s3)then
            ik1=211
            ik2=-2224
!       -2224 is the Kf code of Delta++ba
            ic=508
!       pion- + nba to pi+ + Delta++ba
        elseif(rlus > s3 .and. rlus <= s4)then
            ik1=113
            ik2=-2212
!       113 is the Kf code of rho0
            ic=511
!       pion- + nba to rho0 + pba
        elseif(rlus > s4 .and. rlus <= s5)then
            ik1=-213
            ik2=-2112
!       -213 is the Kf code of rho-
            ic=512
!       pion- + nba to rho- + nba
        elseif(rlus > s5 .and. rlus <= s6)then
            ik1=-211
            ik2=-2114
!       -2114 is the Kf code of Delta0ba
            ic=509
        elseif(rlus > s6 .and. rlus <= s7)then
            ik1=-311
            ik2=-3222
!       -3222 is the Kf code of Sigma+ba
            ic=28
!       pion- + nba to K0ba + Sigma+ba
        else
            ik1=111
            ik2=-2214
!       -2214 is the Kf code of Delta+ba
            ic=510
!       pion- + nba to pi0 + Delta+ba
        endif
        lc(3)=ik1
        lc(4)=ik2
        lc(5)=ic
        tw=sigma18/cspin/10.
        ioo=1


        return
        end



!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
        subroutine pi_nbar2(ss,lc,tw,ioo)
!!      A part of "piN_coll" to deat with pion+ + nba -> ...
        IMPLICIT DOUBLE PRECISION(A-H, O-Z)
        IMPLICIT INTEGER(I-N)
        INTEGER PYCOMP
!       Calculates particle production weight and fills up lc(i,3-5),tw(i).
!       tw : the ratio of cross section of (special inela.)/tot
        COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4)
        COMMON/PYCIDAT2/KFMAXT,NONT2,PARAM(100)
        SAVE /PYCIDAT2/
        common/sa10_h/csnn,cspin,cskn,cspipi,cspsn,cspsm,rcsit,ifram, &
         iabsb,iabsm,i_sigma_AQM,csspn,csspm
        common/count_h/isinel(2000)
        common/iloval/ilo1,ilo2,ilo3,ilo4,ilo5,ilo6,ilo7,ilo8,ilo9
        integer :: lc(6)


        ioo = 0
        if(isinel(502) == 0)then
            sigma1=0.
            goto 222
        endif
        the=PMAS(PYCOMP(111),1)+PMAS(PYCOMP(-1114),1)
        sigma1=sdelta(ss,ilo1,0,the)
!       Cross section of pion+ + nba to Delta-ba + pi0
222     if(isinel(503) == 0)then
            sigma2=0.
            goto 223
        endif
        the=PMAS(PYCOMP(213),1)+PMAS(PYCOMP(-2112),1)
        sigma2=srho(ss,ilo2,0,the)
!       Cross section of pion+ + nba to rho+ + nba.
223     if(isinel(504) == 0)then
            sigma3=0.
            goto 228
        endif
        the=PMAS(PYCOMP(211),1)+PMAS(PYCOMP(-2114),1)
        sigma3=sdelta(ss,ilo3,0,the)
!       Cross section of pion+ + nba to Delta0 + pion-.
228     if(isinel(24) == 0)then
            sigma4=0.
            goto 818
        endif
        ilo4=1
        the=PMAS(PYCOMP(-311),1)+PMAS(PYCOMP(-3112),1)
        sigma4=s1724(ss,ilo4,0,the)
!       Cross section of pion+ + nba to K0ba + Sigma-ba.
818     if(ilo1 == 0.and.ilo2 == 0.and.ilo3 == 0 &
            .and.ilo4 == 0) return
        if(sigma1 < 1D-6 .and. sigma2 < 1D-6.and. &
            sigma3 < 1D-6.and. sigma4 < 1D-6) return
        sigm12=sigma1+sigma2
        sigm13=sigm12+sigma3
        sigm14=sigm13+sigma4
        s1=sigma1/sigm14
        s2=sigm12/sigm14
        s3=sigm13/sigm14
        rlu1=PYR(1)
        if(rlu1 <= s1)then
            ik1=111
            ik2=-1114
            ic=502
!       Cross section of pion+ + nba to Delta-ba + pi0
        elseif(rlu1 > s1 .and. rlu1 <= s2)then
            ik1=213
            ik2=-2112
            ic=503
!       Cross section of pion+ + nba to rho+ + nba
        elseif(rlu1 > s2 .and. rlu1 <= s3)then
            ik1=211
            ik2=-2114
!       Cross section of pion+ + nba to Delta0ba + pion+.
            ic=504
        else
            ik1=-311
            ik2=-3112
            ic=24
!       Cross section of pion+ + nba to K0ba + Sigma-ba.
        endif
        lc(3)=ik1
        lc(4)=ik2
        lc(5)=ic
        tw=sigm14/cspin/10.
        ioo=1


        return
        end



!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
        subroutine pi_nbar3(ss,lc,tw,ioo)
!!      A part of "piN_coll" to deal with pion0 + nba to ...
        IMPLICIT DOUBLE PRECISION(A-H, O-Z)
        IMPLICIT INTEGER(I-N)
        INTEGER PYCOMP
!       Calculates particle production weight and fills up lc(i,3-5),tw(i).
!       tw : the ratio of cross section of (special inela.)/tot
        COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4)
        COMMON/PYCIDAT2/KFMAXT,NONT2,PARAM(100)
        SAVE /PYCIDAT2/
        common/sa10_h/csnn,cspin,cskn,cspipi,cspsn,cspsm,rcsit,ifram, &
         iabsb,iabsm,i_sigma_AQM,csspn,csspm
        common/count_h/isinel(2000)
        common/iloval/ilo1,ilo2,ilo3,ilo4,ilo5,ilo6,ilo7,ilo8,ilo9
        integer :: lc(6)


        ioo = 0
        if(isinel(522) == 0)then
            sigma1=0.
            goto 216
        endif
        ilo1=1
        the=PMAS(PYCOMP(213),1)+PMAS(PYCOMP(-2212),1)
        sigma1=srho(ss,ilo1,0,the)
!       Cross section of pion0 + nba to rho+ + pba.
216     if(isinel(518) == 0)then
            sigma2=0.
            goto 217
        endif
!       the: threshold energy of a reaction
        the=PMAS(PYCOMP(211),1)+PMAS(PYCOMP(-2214),1)
        sigma2=sdelta(ss,ilo2,0,the)
!       Cross section of pion0 + nba to Delta+ba + pi+.
217     if(isinel(521) == 0)then
            sigma3=0.
            goto 218
        endif
        the=PMAS(PYCOMP(113),1)+PMAS(PYCOMP(-2112),1)
        sigma3=srho(ss,ilo3,0,the)
!       Cross section of pion0 + nba to rho0 + nba.
218     if(isinel(519) == 0)then
            sigma4=0.
            goto 807
        endif
        the=PMAS(PYCOMP(-211),1)+PMAS(PYCOMP(-1114),1)
        sigma4=sdelta(ss,ilo4,0,the)
!       Cross section of pion0 + nba to Delta-ba + pion-.
807     if(isinel(33) == 0)then
            sigma5=0.
            goto 811
        endif
        ilo5=1
        the=PMAS(PYCOMP(-311),1)+PMAS(PYCOMP(-3122),1)
        sigma5=s2317(ss,ilo5,0,the)
!       Cross section of pion0 + nba to K0ba + Lambda0ba is assumed
!        to be cross section of pion0 + pba to K- + Lambda0ba.
811     if(isinel(32) == 0)then
            sigma6=0.
            goto 816
        endif
        ilo6=1
        the=PMAS(PYCOMP(-321),1)+PMAS(PYCOMP(-3112),1)
        sigma6=s2325(ss,ilo6,0,the)
!       Cross section of pion0 + nba to K- + Sigma-ba.
816     if(isinel(34) == 0)then
            sigma7=0.
            goto 817
        endif
        ilo7=1
        the=PMAS(PYCOMP(-311),1)+PMAS(PYCOMP(-3212),1)
        sigma7=s1724(ss,ilo7,0,the)
!       Cross section of pion0 + nba to K0ba + Sigma0ba.
817     if(isinel(520) == 0)then
            sigma8=0.
            goto 827
        endif
        the=PMAS(PYCOMP(111),1)+PMAS(PYCOMP(-2114),1)
        sigma8=sdelta(ss,ilo8,0,the)
!       Cross section of pion0 + nba to Delta0ba + pion0.
827     if(ilo1 == 0 .and. ilo2 == 0 .and. ilo3 == 0.and. &
            ilo4 == 0.and. ilo5 == 0 &
            .and. ilo6 == 0 .and. ilo7 == 0 .and. ilo8 == 0) return
        if(sigma1 < 1D-6 .and. sigma2 < 1D-6 .and. sigma3 < 1D-6 &
            .and. sigma4 < 1D-6.and. sigma5 < 1D-6 &
            .and. sigma6 < 1D-6.and. sigma7 < 1D-6 &
            .and. sigma8 < 1D-6) return
        sigma12=sigma1+sigma2
        sigma13=sigma12+sigma3
        sigma14=sigma13+sigma4
        sigma15=sigma14+sigma5
        sigma16=sigma15+sigma6
        sigma17=sigma16+sigma7
        sigma18=sigma17+sigma8
        s1=sigma1/sigma18
        s2=sigma12/sigma18
        s3=sigma13/sigma18
        s4=sigma14/sigma18
        s5=sigma15/sigma18
        s6=sigma16/sigma18
        s7=sigma17/sigma18
        rlus=PYR(1)
        if(rlus <= s1)then
            ik1=213
            ik2=-2212
!       213 is the flavor code of rho+
            ic=522
!       pion0 + nba to pba + rho+
        elseif(rlus > s1 .and. rlus <= s2)then
            ik1=211
            ik2=-2214
!       -2214 is the flavor code of Delta+ba
            ic=518
!       pion0 + nba to Delta+ba + pi+
        elseif(rlus > s2 .and. rlus <= s3)then
            ik1=113
            ik2=-2112
!       113 is the kf code of rho0
            ic=521
!       pion0 + nba to rho0  +  nba
        elseif(rlus > s3 .and. rlus <= s4)then
            ik1=-211
            ik2=-1114
!       -1114 is the kf code of Delta-ba
            ic=519
        elseif(rlus > s4 .and. rlus <= s5)then
            ik1=-311
            ik2=-3122
!       -3122 is the kf code of Lambda0ba
            ic=33
!       pion0 + nba to K0 + Lambda0
        elseif(rlus > s5 .and. rlus <= s6)then
            ik1=-321
            ik2=-3112
!       -3112 is the kf code of Sigma-ba
            ic=32
        elseif(rlus > s6 .and. rlus <= s7)then
!       pion0 + nba to K- + Sigma-ba
            ik1=-311
            ik2=-3212
!       -3212 is the kf code of Sigma0ba
            ic=34
!       pion0 + nba to K0ba + Sigma0ba
        else
            ik1=111
            ik2=-2114
!       -2114 is the kf code of Delta0ba
            ic=520
!       pion0 + nba to pi0 + Delta0ba
        endif
        lc(3)=ik1
        lc(4)=ik2
        lc(5)=ic
        tw=sigma18/cspin/10.
        ioo=1


        return
        end



!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
        function s1713(ss,ilo,i,the)
        IMPLICIT DOUBLE PRECISION(A-H, O-Z)
        IMPLICIT INTEGER(I-N)
        common/sa13/kjp20,non13,vjp20,vjp21,vjp22,vjp23
!       pion+ + p to K+ + Sigma+, channel 7
        ilo=0
        si=0.
        ii=i
        if(ii == 1) goto 30
        if(ss <= the) goto 100
30      ilo=1
        if(ss >= 1.934) goto 10
        IF(kjp20 == 0)THEN
            si=0.7*(ss-1.683)/0.218
        ELSE
            si=vjp20
        ENDIF
        goto 100
10      if(ss >= 3.) goto 20
        IF(kjp20 == 0)THEN
            si=60.26*exp(max(-40.,-2.31*ss))
        ELSE
            si=vjp20
        ENDIF
        goto 100
20      IF(kjp20 == 0)THEN
            si=0.36*exp(max(-40.,-0.605*ss))
        ELSE
            si=vjp20
        ENDIF
100     s1713=si
        return
        end



!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
        function s1724(ss,ilo,i,the)
        IMPLICIT DOUBLE PRECISION(A-H, O-Z)
        IMPLICIT INTEGER(I-N)
        common/sa13/kjp20,non13,vjp20,vjp21,vjp22,vjp23
!       pion+ + n to K+ + Sigma0, channel 8
        ilo=0
        si=0.
        ii=i
        if(ii == 1) goto 30
        if(ss <= the) goto 100
30      ilo=1
        IF(kjp20 == 0)THEN
            si=0.25*(s0715(ss,ilo,ii,the)+s07123(ss,ilo,ii,the)+ &
                s1713(ss,ilo,ii,the))
        ELSE
            si=vjp20
        ENDIF
100     s1724=si
        return
        end



!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
        function s1727(ss,ilo,i,the)
        IMPLICIT DOUBLE PRECISION(A-H, O-Z)
        IMPLICIT INTEGER(I-N)
        common/sa13/kjp20,non13,vjp20,vjp21,vjp22,vjp23
!       pion+ + n to k+ + Lambda0, channel 9
        ilo=0
        si=0.
        ii=i
        if(ii == 1) goto 30
        if(ss <= the) goto 100
30      ilo=1
        if(ss >= 1.684) goto 10
        IF(kjp20 == 0)THEN
            si=0.9*(ss-1.613)/0.091
        ELSE
            si=vjp20
        ENDIF
        goto 100
10      if(ss >= 2.1) goto 20
        IF(kjp20 == 0)THEN
            si=436.3*exp(max(-40.,-4.154*ss))
        ELSE
            si=vjp20
        ENDIF
        goto 100
20      IF(kjp20 == 0)THEN
            si=0.314*exp(max(-40.,-0.301*ss))
        ELSE
            si=vjp20
        ENDIF
!*SA
!100    s1727=si*0.25
100     s1727=si
        return
        end



!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
        function s0715(ss,ilo,i,the)
        IMPLICIT DOUBLE PRECISION(A-H, O-Z)
        IMPLICIT INTEGER(I-N)
        common/sa13/kjp20,non13,vjp20,vjp21,vjp22,vjp23
!       pion- + p to K+ + Sigma-, channel 11
        ilo=0
        si=0.
        ii=i
        if(ii == 1) goto 30
        if(ss <= the) goto 100
30      ilo=1
        if(ss >= 1.9) goto 10
        IF(kjp20 == 0)then
            si=0.25*(1.-0.75*(ss-1.691))
        else
            si=vjp20
        endif
        goto 100
10      IF(kjp20 == 0)then
            si=309.1*exp(max(-40.,-3.77*ss))
        else
            si=vjp20
        endif
100     continue
        s0715=si
        return
        end



!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
        function s07122(ss,ilo,i,the)
        IMPLICIT DOUBLE PRECISION(A-H, O-Z)
        IMPLICIT INTEGER(I-N)
        common/sa13/kjp20,non13,vjp20,vjp21,vjp22,vjp23
!       pion- + p to k0 + Lambda0, channel 12
        ilo=0
        si=0.
        ii=i
        if(ii == 1) goto 30
        if(ss <= the) goto 100
30      ilo=1
        if(ss >= 1.684) goto 10
        IF(kjp20 == 0)THEN
            si=0.9/0.091*(ss-1.613)
        ELSE
            si=vjp20
        ENDIF
        goto 100
10      if(ss >= 2.1) goto 20
        IF(kjp20 == 0)THEN
            si=436.3*exp(max(-40.,-4.154*ss))
        ELSE
            si=vjp20
        ENDIF
        goto 100
20      IF(kjp20 == 0)THEN
            si=0.314*exp(max(-40.,-0.301*ss))
        ELSE
            si=vjp20
        ENDIF
100     s07122=si
        return
        end



!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
        function s07123(ss,ilo,i,the)
        IMPLICIT DOUBLE PRECISION(A-H, O-Z)
        IMPLICIT INTEGER(I-N)
        common/sa13/kjp20,non13,vjp20,vjp21,vjp22,vjp23
!       pion- + p to k0 + Sigma0, channel 13
        ilo=0
        si=0.
        ii=i
        if(ii == 1) goto 30
        if(ss <= the) goto 100
30      ilo=1
        if(ss >= 1.722) goto 10
        IF(kjp20 == 0)THEN
            si=10.6*(ss-1.689)
        ELSE
            si=vjp20
        ENDIF
        goto 100
10      if(ss >= 3.) goto 20
        IF(kjp20 == 0)THEN
            si=13.7*exp(max(-40.,-1.92*ss))
        ELSE
            si=vjp20
        ENDIF
        goto 100
20      IF(kjp20 == 0)THEN
            si=0.188*exp(max(-40.,-0.611*ss))
        ELSE
            si=vjp20
        ENDIF
100     s07123=si
        return
        end



!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
        function s2314(ss,ilo,i,the)
        IMPLICIT DOUBLE PRECISION(A-H, O-Z)
        IMPLICIT INTEGER(I-N)
!       pion0 + p to K+ + Sigma0, channel 15
        ii=i
        s2314=s1724(ss,ilo,ii,the)
        return
        end



!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
        function s2317(ss,ilo,i,the)
        IMPLICIT DOUBLE PRECISION(A-H, O-Z)
        IMPLICIT INTEGER(I-N)
!       pion0 + p to K+ + Lambda0, channel 16
        ii=i
        s2317=s1727(ss,ilo,ii,the)
        return
        end



!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
        function s2325(ss,ilo,i,the)
        IMPLICIT DOUBLE PRECISION(A-H, O-Z)
        IMPLICIT INTEGER(I-N)
!       pion0 + n to K+ + Sigma-, channel 18
        ii=i
        s2325=s1724(ss,ilo,ii,the)
        return
        end



!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
        function sdelta(ss,ilo,i,the)
        IMPLICIT DOUBLE PRECISION(A-H, O-Z)
        IMPLICIT INTEGER(I-N)
        common/sa13/kjp20,non13,vjp20,vjp21,vjp22,vjp23
!       pion + N to pion + Delta
        ilo=0
        si=0.
        ii=i
        if(ii == 1) goto 30
        if(ss <= the) goto 100
30      ilo=1
        if(ss >= 1.6941) goto 10
        IF(kjp20 == 0)THEN
            si=-61.127+42.9365*ss
        ELSE
            si=vjp21
        ENDIF
        goto 100
10      IF(kjp20 == 0)THEN
            sit=-0.0186959*ss**3+0.310359*ss**2-0.755106*ss+0.565481
            si=1.0/sit
        ELSE
            si=vjp21
        ENDIF
100     sdelta=si
        return
        end



!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
        function srho(ss,ilo,i,the)
        IMPLICIT DOUBLE PRECISION(A-H, O-Z)
        IMPLICIT INTEGER(I-N)
        common/sa13/kjp20,non13,vjp20,vjp21,vjp22,vjp23
!       pion + N to rho + N
        ilo=0
        si=0.
        ii=i
        if(ii == 1) goto 30
        if(ss <= the) goto 100
30      ilo=1
        if(ss >= 1.8837) goto 10
        IF(kjp20 == 0)THEN
            si=-23.3607+13.9936*ss
        ELSE
            si=vjp22
        ENDIF
        goto 100
10      IF(kjp20 == 0)THEN
            sit=0.331583*ss**3-1.86123*ss**2+3.81364*ss-2.50068
            si=1.0/sit
        ELSE
            si=vjp22
        ENDIF
100     srho=si
        return
        end



!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
        subroutine piDelta_coll( kl, kl1, ss, lc, tw, ioo )
!!      A part of "prod" to deal with pi + Delta --> ...
!       Finds production and fills up lc(i,3-5), tw(i).
!       pion + Delta channels are defined as 347-362, 523-538.
!       kl, kl1: the KF code.
!       ss: the total energy (invariant mass) of two hadrons.
!       lc: collision list.
!       tw: the ratio of cross section of (special inela.)/tot.
!       ioo: flag of elastic (0) and inelastic (1) treatment.
        IMPLICIT DOUBLE PRECISION(A-H, O-Z)
        IMPLICIT INTEGER(I-N)
        common/sa10_h/csnn,cspin,cskn,cspipi,cspsn,cspsm,rcsit,ifram, &
         iabsb,iabsm,i_sigma_AQM,csspn,csspm
        common/sa20_h/t0,cspipiKK,dep,ddt,edipi,epin,ecsnn,ekn,ecspsn,ecspsm, &
         rnt,rnp,ecsspn,ecsspm
        common/iloval/ilo1,ilo2,ilo3,ilo4,ilo5,ilo6,ilo7,ilo8,ilo9
        common/count_h/isinel(2000)
        integer :: lc(6)


        ioo = 0
        ilo = 1

!       pi + Delta
        if( kl1 > 0 )then

!       pion+ + delta-
            if((kl == 211 .and. kl1 == 1114).or. &
                (kl1 == 211 .and. kl == 1114))then
                if(isinel(347) == 0)then
                    si1=0D0
                    goto 1000
                endif
                ik1=-211
                ik2=2212
                call srev(kl,kl1,ik1,ik2,ss,ilo1,fac, &
                1.0,1.5,0.,1.5,1.0,0.5,0.,0.5,1.)
                if(ilo1 == 0)then
                    si1=0D0
                else
                    si1=sdelta(ss,ilo1,1,0.d0)*fac
                endif
!       Cross section of pion+ + delta- to pi- + p.
1000            if(isinel(348) == 0)then
                    si2=0D0
                    goto 1002
                endif
                ik1=111
                ik2=2112
                call srev(kl,kl1,ik1,ik2,ss,ilo2,fac, &
                 1.0,1.5,0.,1.5,1.0,0.5,0.,0.5,1.)
                if(ilo2 == 0)then
                    si2=0D0
                else
! Since threshold energy is check in srev() we set the=0D0 here in sdelta().
                    si2=sdelta(ss,ilo2,1,0.d0)*fac
                endif
!       Cross section of pion+ + delta- to pi0 + n
1002            if(ilo1 == 0 .and. ilo2 == 0) return
                if(si1 < 1D-6.and.si2 < 1D-6) return
                si12=si1+si2
                s1=si1/si12
                rlu1=PYR(1)
                if(rlu1 <= s1)then
                    ik1=-211
                    ik2=2212
                    ic=347
!       Cross section of pion+ + delta- to pi- + p.
                    goto 1004
                endif
                ik1=111
                ik2=2112
                ic=348
!       Cross section of pion+ + delta- to pi0 + n.
1004            lc(3)=ik1
                lc(4)=ik2
                lc(5)=ic
                tw=si12/cspin/10D0

!       pion+ + delta0
            else if((kl == 211 .and. kl1 == 2114).or. &
                (kl1 == 211 .and. kl == 2114))then
                if(isinel(349) == 0)then
                    si1=0D0
                    goto 1006
                endif
                ik1=211
                ik2=2112
                call srev(kl,kl1,ik1,ik2,ss,ilo1,fac, &
                1.0,1.5,0.,1.5,1.0,0.5,0.,0.5,1.)
                if(ilo1 == 0)then
                    si1=0D0
                else
                    si1=sdelta(ss,ilo1,1,0.d0)*fac
                endif
!       Cross section of pion+ + delta0 to pi+ + n.
1006            if(isinel(350) == 0)then
                    si2=0D0
                    goto 1008
                endif
                ik1=111
                ik2=2212
                call srev(kl,kl1,ik1,ik2,ss,ilo2,fac, &
                1.0,1.5,0.,1.5,1.0,0.5,0.,0.5,1.)
                if(ilo2 == 0)then
                    si2=0D0
                else
! Since threshold energy is check in srev() we set the=0D0 here in sdelta().
                    si2=sdelta(ss,ilo2,1,0.d0)*fac
                endif
!       Cross section of pion+ + delta0 to pi0 + p.
1008            if(ilo1 == 0 .and. ilo2 == 0) return
                if(si1 < 1D-6.and.si2 < 1D-6) return
                si12=si1+si2
                s1=si1/si12
                rlu1=PYR(1)
                if(rlu1 <= s1)then
                    ik1=211
                    ik2=2112
                    ic=349
!       Cross section of pion+ + delta0 to pi+ + n.
                    goto 1010
                endif
                ik1=111
                ik2=2212
                ic=350
!       Cross section of pion+ + delta0 to pi0 + p.
1010            lc(3)=ik1
                lc(4)=ik2
                lc(5)=ic
                tw=si12/cspin/10D0

!       pion+ + delta+ to pi+ + p
            else if((kl == 211 .and. kl1 == 2214).or. &
                (kl1 == 211 .and. kl == 2214))then
                if(isinel(351) == 0) return
                ik3=211
                ik4=2212
                call srev(kl,kl1,ik3,ik4,ss,ilo,fac, &
                 1.0,1.5,0.,1.5,1.0,0.5,0.,0.5,1.)
                if(ilo == 0) return
                lc(3)=211
                lc(4)=2212
                lc(5)=351
                ww=sdelta(ss,ilo1,1,0.d0)/cspin/10D0
                tw=ww*fac

!       pion0 + delta++ to pi+ + p
            else if((kl == 111 .and. kl1 == 2224).or. &
                (kl1 == 111 .and. kl == 2224))then
                if(isinel(352) == 0) return
                ik3=211
                ik4=2212
                call srev(kl,kl1,ik3,ik4,ss,ilo,fac, &
                1.0,1.5,0.,1.5,1.0,0.5,0.,0.5,1.)
                if(ilo == 0) return
                lc(3)=211
                lc(4)=2212
                lc(5)=352
                ww=sdelta(ss,ilo1,1,0.d0)/cspin/10D0
                tw=ww*fac

!       pion0 + delta+
            else if((kl == 111 .and. kl1 == 2214).or. &
                (kl1 == 111 .and. kl == 2214))then
                if(isinel(353) == 0)then
                    si1=0D0
                    goto 1012
                endif
                ik1=111
                ik2=2212
                call srev(kl,kl1,ik1,ik2,ss,ilo1,fac, &
                1.0,1.5,0.,1.5,1.0,0.5,0.,0.5,1.)
                if(ilo1 == 0)then
                    si1=0D0
                else
                    si1=sdelta(ss,ilo1,1,0.d0)*fac
                endif
!       Cross section of pion0 + delta+ to pi0 + p.
1012            if(isinel(354) == 0)then
                    si2=0D0
                    goto 1014
                endif
                ik1=211
                ik2=2112
                call srev(kl,kl1,ik1,ik2,ss,ilo2,fac, &
                1.0,1.5,0.,1.5,1.0,0.5,0.,0.5,1.)
                if(ilo2 == 0)then
                    si2=0D0
                else
! Since threshold energy is check in srev() we set the=0D0 here in sdelta().
                    si2=sdelta(ss,ilo2,1,0.d0)*fac
                endif
!       Cross section of pion0 + delta+ to pi+ + n
1014            if(ilo1 == 0 .and. ilo2 == 0) return
                if(si1 < 1D-6.and.si2 < 1D-6) return
                si12=si1+si2
                s1=si1/si12
                rlu1=PYR(1)
                if(rlu1 <= s1)then
                    ik1=111
                    ik2=2212
                    ic=353
!       Cross section of pion0 + delta+ to pi0 + p.
                    goto 1016
                endif
                ik1=211
                ik2=2112
                ic=354
!       Cross section of pion0 + delta+ to pi+ + n.
1016            lc(3)=ik1
                lc(4)=ik2
                lc(5)=ic
                tw=si12/cspin/10D0

!       pion0 + delta0
            else if((kl == 111 .and. kl1 == 2114).or. &
                (kl1 == 111 .and. kl == 2114))then
                if(isinel(355) == 0)then
                    si1=0D0
                    goto 1018
                endif
                ik1=111
                ik2=2112
                call srev(kl,kl1,ik1,ik2,ss,ilo1,fac, &
                1.0,1.5,0.,1.5,1.0,0.5,0.,0.5,1.)
                if(ilo1 == 0)then
                    si1=0D0
                else
                    si1=sdelta(ss,ilo1,1,0.d0)*fac
                endif
!       Cross section of pion0 + delta0 to pi0 + n.
1018            if(isinel(356) == 0)then
                    si2=0D0
                    goto 1020
                endif
                ik1=-211
                ik2=2212
                call srev(kl,kl1,ik1,ik2,ss,ilo2,fac, &
                1.0,1.5,0.,1.5,1.0,0.5,0.,0.5,1.)
                if(ilo2 == 0)then
                    si2=0D0
                else
! Since threshold energy is check in srev() we set the=0D0 here in sdelta().
                    si2=sdelta(ss,ilo2,1,0.d0)*fac
                endif
!       Cross section of pion0 + delta0 to pi- + p
1020            if(ilo1 == 0 .and. ilo2 == 0) return
                if(si1 < 1D-6.and.si2 < 1D-6) return
                si12=si1+si2
                s1=si1/si12
                rlu1=PYR(1)
                if(rlu1 <= s1)then
                    ik1=111
                    ik2=2112
                    ic=355
!       Cross section of pion0 + delta0 to pi0 + n.
                    goto 1022
                endif
                ik1=-211
                ik2=2212
                ic=356
!       Cross section of pion0 + delta0 to pi- + p.
1022            lc(3)=ik1
                lc(4)=ik2
                lc(5)=ic
                tw=si12/cspin/10D0

!       pion0 + delta- to pi- + n
            else if((kl == 111 .and. kl1 == 1114).or. &
                (kl1 == 111 .and. kl == 1114))then
                if(isinel(357) == 0) return
                    ik3=-211
                    ik4=2112
                call srev(kl,kl1,ik3,ik4,ss,ilo,fac, &
                1.0,1.5,0.,1.5,1.0,0.5,0.,0.5,1.)
                if(ilo == 0) return
                lc(3)=-211
                lc(4)=2112
                lc(5)=357
                ww=sdelta(ss,ilo1,1,0.d0)/cspin/10D0
                tw=ww*fac

!       pion- + delta++
            else if((kl == -211 .and. kl1 == 2224).or. &
                (kl1 == -211 .and. kl == 2224))then
                if(isinel(358) == 0)then
                    si1=0D0
                    goto 1024
                endif
                ik1=111
                ik2=2212
                call srev(kl,kl1,ik1,ik2,ss,ilo1,fac, &
                1.0,1.5,0.,1.5,1.0,0.5,0.,0.5,1.)
                if(ilo1 == 0)then
                    si1=0D0
                else
                    si1=sdelta(ss,ilo1,1,0.d0)*fac
                endif
!       Cross section of pion- + delta++ to pi0 + p.
1024            if(isinel(359) == 0)then
                    si2=0D0
                    goto 1026
                endif
                ik1=211
                ik2=2112
                call srev(kl,kl1,ik1,ik2,ss,ilo2,fac, &
                1.0,1.5,0.,1.5,1.0,0.5,0.,0.5,1.)
                if(ilo2 == 0)then
                    si2=0D0
                else
! Since threshold energy is check in srev() we set the=0D0 here in sdelta().
                    si2=sdelta(ss,ilo2,1,0.d0)*fac
                endif
!       Cross section of pion- + delta++ to pi+ + n.
1026            if(ilo1 == 0 .and. ilo2 == 0) return
                if(si1 < 1D-6.and.si2 < 1D-6) return
                si12=si1+si2
                s1=si1/si12
                rlu1=PYR(1)
                if(rlu1 <= s1)then
                    ik1=111
                    ik2=2212
                    ic=358
!       Cross section of pion- + delta++ to pi0 + p.
                    goto 1028
                endif
                ik1=211
                ik2=2112
                ic=359
!       Cross section of pion- + delta++ to pi+ + n.
1028            lc(3)=ik1
                lc(4)=ik2
                lc(5)=ic
                tw=si12/cspin/10D0

!       pion- + delta+
            else if((kl == -211 .and. kl1 == 2214).or. &
                (kl1 == -211 .and. kl == 2214))then
                if(isinel(360) == 0)then
                    si1=0D0
                    goto 1030
                endif
                ik1=-211
                ik2=2212
                call srev(kl,kl1,ik1,ik2,ss,ilo1,fac, &
                1.0,1.5,0.,1.5,1.0,0.5,0.,0.5,1.)
                if(ilo1 == 0)then
                    si1=0D0
                else
                    si1=sdelta(ss,ilo1,1,0.d0)*fac
                endif
!       Cross section of pion- + delta+ to pi- + p.
1030            if(isinel(361) == 0)then
                    si2=0D0
                    goto 1032
                endif
                ik1=111
                ik2=2112
                call srev(kl,kl1,ik1,ik2,ss,ilo2,fac, &
                1.0,1.5,0.,1.5,1.0,0.5,0.,0.5,1.)
                if(ilo2 == 0)then
                    si2=0D0
                else
! Since threshold energy is check in srev() we set the=0D0 here in sdelta().
                    si2=sdelta(ss,ilo2,1,0.d0)*fac
                endif
!       Cross section of pion- + delta+ to pi0 + n.
1032            if(ilo1 == 0 .and. ilo2 == 0) return
                if(si1 < 1D-6.and.si2 < 1D-6) return
                si12=si1+si2
                s1=si1/si12
                rlu1=PYR(1)
                if(rlu1 <= s1)then
                    ik1=-211
                    ik2=2212
                    ic=360
!       Cross section of pion- + delta+ to pi- + p.
                    goto 1034
                endif
                ik1=111
                ik2=2112
                ic=361
!       Cross section of pion- + delta+ to pi0 + n.
1034            lc(3)=ik1
                lc(4)=ik2
                lc(5)=ic
                tw=si12/cspin/10D0

!       pion- + delta0 to pi- + n
            else if((kl == -211 .and. kl1 == 2114).or. &
                (kl1 == -211 .and. kl == 2114))then
                if(isinel(362) == 0) return
                ik3=-211
                ik4=2112
                call srev(kl,kl1,ik3,ik4,ss,ilo,fac, &
                1.0,1.5,0.,1.5,1.0,0.5,0.,0.5,1.)
                if(ilo == 0) return
                lc(3)=-211
                lc(4)=2112
                lc(5)=362
                ww=sdelta(ss,ilo1,1,0.d0)/cspin/10D0
                tw=ww*fac

            else
                write(*,*) "Warning! piDelta_coll-Delta: some channels " &
                        // "are missing. KF1, KF2 =", kl, kl1
                return
            endif

!       pi + Deltabar
        else

!       pion- + delta-ba
            if((kl == -211 .and. kl1 == -1114).or. &
                (kl1 == -211 .and. kl == -1114))then
                if(isinel(523) == 0)then
                    si1=0D0
                    goto 2000
                endif
                ik1=211
                ik2=-2212
                call srev(kl,kl1,ik1,ik2,ss,ilo1,fac, &
                1.0,1.5,0.,1.5,1.0,0.5,0.,0.5,1.)
                if(ilo1 == 0)then
                    si1=0D0
                else
                    si1=sdelta(ss,ilo1,1,0.d0)*fac
                endif
!       Cross section of pion- + delta-ba to pi+ + pba.
2000            if(isinel(524) == 0)then
                    si2=0D0
                    goto 2002
                endif
                ik1=111
                ik2=-2112
                call srev(kl,kl1,ik1,ik2,ss,ilo2,fac, &
                 1.0,1.5,0.,1.5,1.0,0.5,0.,0.5,1.)
                if(ilo2 == 0)then
                    si2=0D0
                else
! Since threshold energy is check in srev() we set the=0D0 here in sdelta().
                    si2=sdelta(ss,ilo2,1,0.d0)*fac
                endif
!       Cross section of pion- + delta-ba to pi0 + nba
2002            if(ilo1 == 0 .and. ilo2 == 0) return
                if(si1 < 1D-6.and.si2 < 1D-6) return
                si12=si1+si2
                s1=si1/si12
                rlu1=PYR(1)
                if(rlu1 <= s1)then
                    ik1=211
                    ik2=-2212
                    ic=523
!       Cross section of pion- + delta-ba to pi+ + pba.
                    goto 2004
                endif
                ik1=111
                ik2=-2112
                ic=524
!       Cross section of pion- + delta-ba to pi0 + nba.
2004            lc(3)=ik1
                lc(4)=ik2
                lc(5)=ic
                tw=si12/cspin/10D0

!       pion- + delta0ba
            else if((kl == -211 .and. kl1 == -2114).or. &
                (kl1 == -211 .and. kl == -2114))then
                if(isinel(525) == 0)then
                    si1=0D0
                    goto 2006
                endif
                ik1=-211
                ik2=-2112
                call srev(kl,kl1,ik1,ik2,ss,ilo1,fac, &
                1.0,1.5,0.,1.5,1.0,0.5,0.,0.5,1.)
                if(ilo1 == 0)then
                    si1=0D0
                else
                    si1=sdelta(ss,ilo1,1,0.d0)*fac
                endif
!       Cross section of pion- + delta0ba to pi- + nba.
2006            if(isinel(526) == 0)then
                    si2=0D0
                    goto 2008
                endif
                ik1=111
                ik2=-2212
                call srev(kl,kl1,ik1,ik2,ss,ilo2,fac, &
                1.0,1.5,0.,1.5,1.0,0.5,0.,0.5,1.)
                if(ilo2 == 0)then
                    si2=0D0
                else
! Since threshold energy is check in srev() we set the=0D0 here in sdelta().
                    si2=sdelta(ss,ilo2,1,0.d0)*fac
                endif
!       Cross section of pion- + delta0ba to pi0 + pba.
2008            if(ilo1 == 0 .and. ilo2 == 0) return
                if(si1 < 1D-6.and.si2 < 1D-6) return
                si12=si1+si2
                s1=si1/si12
                rlu1=PYR(1)
                if(rlu1 <= s1)then
                    ik1=-211
                    ik2=-2112
                    ic=525
!       Cross section of pion- + delta0ba to pi- + nba.
                    goto 2010
                endif
                ik1=111
                ik2=-2212
                ic=526
!       Cross section of pion- + delta0ba to pi0 + pba.
2010            lc(3)=ik1
                lc(4)=ik2
                lc(5)=ic
                tw=si12/cspin/10D0

!       pion- + delta+ba to pi- + pba
            else if((kl == -211 .and. kl1 == -2214).or. &
                (kl1 == -211 .and. kl == -2214))then
                if(isinel(527) == 0) return
                ik3=-211
                ik4=-2212
                call srev(kl,kl1,ik3,ik4,ss,ilo,fac, &
                 1.0,1.5,0.,1.5,1.0,0.5,0.,0.5,1.)
                if(ilo == 0) return
                lc(3)=-211
                lc(4)=-2212
                lc(5)=527
                ww=sdelta(ss,ilo1,1,0.d0)/cspin/10D0
                tw=ww*fac

!       pion0 + delta++ba to pi- + pba
            else if((kl == 111 .and. kl1 == -2224).or. &
                (kl1 == 111 .and. kl == -2224))then
                if(isinel(528) == 0) return
                ik3=-211
                ik4=-2212
                call srev(kl,kl1,ik3,ik4,ss,ilo,fac, &
                1.0,1.5,0.,1.5,1.0,0.5,0.,0.5,1.)
                if(ilo == 0) return
                lc(3)=-211
                lc(4)=-2212
                lc(5)=528
                ww=sdelta(ss,ilo1,1,0.d0)/cspin/10D0
                tw=ww*fac

!       pion0 + delta+ba
            else if((kl == 111 .and. kl1 == -2214).or. &
                (kl1 == 111 .and. kl == -2214))then
                if(isinel(529) == 0)then
                    si1=0D0
                    goto 2012
                endif
                ik1=111
                ik2=-2212
                call srev(kl,kl1,ik1,ik2,ss,ilo1,fac, &
                1.0,1.5,0.,1.5,1.0,0.5,0.,0.5,1.)
                if(ilo1 == 0)then
                    si1=0D0
                else
                    si1=sdelta(ss,ilo1,1,0.d0)*fac
                endif
!       Cross section of pion0 + delta+ba to pi0 + pba.
2012            if(isinel(530) == 0)then
                    si2=0D0
                    goto 2014
                endif
                ik1=-211
                ik2=-2112
                call srev(kl,kl1,ik1,ik2,ss,ilo2,fac, &
                1.0,1.5,0.,1.5,1.0,0.5,0.,0.5,1.)
                if(ilo2 == 0)then
                    si2=0D0
                else
! Since threshold energy is check in srev() we set the=0D0 here in sdelta().
                    si2=sdelta(ss,ilo2,1,0.d0)*fac
                endif
!       Cross section of pion0 + delta+ba to pi- + nba
2014            if(ilo1 == 0 .and. ilo2 == 0) return
                if(si1 < 1D-6.and.si2 < 1D-6) return
                si12=si1+si2
                s1=si1/si12
                rlu1=PYR(1)
                if(rlu1 <= s1)then
                    ik1=111
                    ik2=-2212
                    ic=529
!       Cross section of pion0 + delta+ba to pi0 + pba.
                    goto 2016
                endif
                ik1=-211
                ik2=-2112
                ic=530
!       Cross section of pion0 + delta+ba to pi- + nba.
2016            lc(3)=ik1
                lc(4)=ik2
                lc(5)=ic
                tw=si12/cspin/10D0

!       pion0 + delta0ba
            else if((kl == 111 .and. kl1 == -2114).or. &
                (kl1 == 111 .and. kl == -2114))then
                if(isinel(531) == 0)then
                    si1=0D0
                    goto 2018
                endif
                ik1=111
                ik2=-2112
                call srev(kl,kl1,ik1,ik2,ss,ilo1,fac, &
                1.0,1.5,0.,1.5,1.0,0.5,0.,0.5,1.)
                if(ilo1 == 0)then
                    si1=0D0
                else
                    si1=sdelta(ss,ilo1,1,0.d0)*fac
                endif
!       Cross section of pion0 + delta0ba to pi0 + nba.
2018            if(isinel(532) == 0)then
                    si2=0D0
                    goto 2020
                endif
                ik1=211
                ik2=-2212
                call srev(kl,kl1,ik1,ik2,ss,ilo2,fac, &
                1.0,1.5,0.,1.5,1.0,0.5,0.,0.5,1.)
                if(ilo2 == 0)then
                    si2=0D0
                else
! Since threshold energy is check in srev() we set the=0D0 here in sdelta().
                    si2=sdelta(ss,ilo2,1,0.d0)*fac
                endif
!       Cross section of pion0 + delta0ba to pi+ + pba
2020            if(ilo1 == 0 .and. ilo2 == 0) return
                if(si1 < 1D-6.and.si2 < 1D-6) return
                si12=si1+si2
                s1=si1/si12
                rlu1=PYR(1)
                if(rlu1 <= s1)then
                    ik1=111
                    ik2=-2112
                    ic=531
!       Cross section of pion0 + delta0ba to pi0 + nba.
                    goto 2022
                endif
                ik1=211
                ik2=-2212
                ic=532
!       Cross section of pion0 + delta0ba to pi+ + pba.
2022            lc(3)=ik1
                lc(4)=ik2
                lc(5)=ic
                tw=si12/cspin/10D0

!       pion0 + delta-ba to pi+ + nba
            else if((kl == 111 .and. kl1 == -1114).or. &
                (kl1 == 111 .and. kl == -1114))then
                if(isinel(533) == 0) return
                ik3=211
                ik4=-2112
                call srev(kl,kl1,ik3,ik4,ss,ilo,fac, &
                1.0,1.5,0.,1.5,1.0,0.5,0.,0.5,1.)
                if(ilo == 0) return
                lc(3)=211
                lc(4)=-2112
                lc(5)=533
                ww=sdelta(ss,ilo1,1,0.d0)/cspin/10D0
                tw=ww*fac

!       pion+ + delta++ba
            else if((kl == 211 .and. kl1 == -2224).or. &
                (kl1 == 211 .and. kl == -2224))then
                if(isinel(534) == 0)then
                    si1=0D0
                    goto 2024
                endif
                ik1=111
                ik2=-2212
                call srev(kl,kl1,ik1,ik2,ss,ilo1,fac, &
                1.0,1.5,0.,1.5,1.0,0.5,0.,0.5,1.)
                if(ilo1 == 0)then
                    si1=0D0
                else
                    si1=sdelta(ss,ilo1,1,0.d0)*fac
                endif
!       Cross section of pion+ + delta++ba to pi0 + pba.
2024            if(isinel(535) == 0)then
                    si2=0D0
                    goto 2026
                endif
                ik1=-211
                ik2=-2112
                call srev(kl,kl1,ik1,ik2,ss,ilo2,fac, &
                1.0,1.5,0.,1.5,1.0,0.5,0.,0.5,1.)
                if(ilo2 == 0)then
                    si2=0D0
                else
! Since threshold energy is check in srev() we set the=0D0 here in sdelta().
                    si2=sdelta(ss,ilo2,1,0.d0)*fac
                endif
!       Cross section of pion+ + delta++ba to pi- + nba.
2026            if(ilo1 == 0 .and. ilo2 == 0) return
                if(si1 < 1D-6.and.si2 < 1D-6) return
                si12=si1+si2
                s1=si1/si12
                rlu1=PYR(1)
                if(rlu1 <= s1)then
                    ik1=111
                    ik2=-2212
                    ic=534
!       Cross section of pion+ + delta++ba to pi0 + pba.
                    goto 2028
                endif
                ik1=-211
                ik2=-2112
                ic=535
!       Cross section of pion+ + delta++ba to pi- + nba.
2028            lc(3)=ik1
                lc(4)=ik2
                lc(5)=ic
                tw=si12/cspin/10D0

!       pion+ + delta+ba
            else if((kl == 211 .and. kl1 == -2214).or. &
                (kl1 == 211 .and. kl == -2214))then
                if(isinel(536) == 0)then
                    si1=0D0
                    goto 2030
                endif
                ik1=211
                ik2=-2212
                call srev(kl,kl1,ik1,ik2,ss,ilo1,fac, &
                1.0,1.5,0.,1.5,1.0,0.5,0.,0.5,1.)
                if(ilo1 == 0)then
                    si1=0D0
                else
                    si1=sdelta(ss,ilo1,1,0.d0)*fac
                endif
!       Cross section of pion+ + delta+ba to pi+ + pba.
2030            if(isinel(537) == 0)then
                    si2=0D0
                    goto 2032
                endif
                ik1=111
                ik2=-2112
                call srev(kl,kl1,ik1,ik2,ss,ilo2,fac, &
                1.0,1.5,0.,1.5,1.0,0.5,0.,0.5,1.)
                if(ilo2 == 0)then
                    si2=0D0
                else
! Since threshold energy is check in srev() we set the=0D0 here in sdelta().
                    si2=sdelta(ss,ilo2,1,0.d0)*fac
                endif
!       Cross section of pion+ + delta+ba to pi0 + nba.
2032            if(ilo1 == 0 .and. ilo2 == 0) return
                if(si1 < 1D-6.and.si2 < 1D-6) return
                si12=si1+si2
                s1=si1/si12
                rlu1=PYR(1)
                if(rlu1 <= s1)then
                    ik1=211
                    ik2=-2212
                    ic=536
!       Cross section of pion+ + delta+ba to pi+ + pba.
                    goto 2034
                endif
                ik1=111
                ik2=-2112
                ic=537
!       Cross section of pion+ + delta+ba to pi0 + nba.
2034            lc(3)=ik1
                lc(4)=ik2
                lc(5)=ic
                tw=si12/cspin/10D0

!       pion+ + delta0ba to pi+ + nba
            else if((kl == 211 .and. kl1 == -2114).or. &
                (kl1 == 211 .and. kl == -2114))then
                if(isinel(538) == 0) return
                ik3=211
                ik4=-2112
                call srev(kl,kl1,ik3,ik4,ss,ilo,fac, &
                1.0,1.5,0.,1.5,1.0,0.5,0.,0.5,1.)
                if(ilo == 0) return
                lc(3)=211
                lc(4)=-2112
                lc(5)=538
                ww=sdelta(ss,ilo1,1,0.d0)/cspin/10D0
                tw=ww*fac

            else
                write(*,*) "Warning! piDelta_coll-Deltabar: some channels " &
                        // "are missing. KF1, KF2 =", kl, kl1
                return
            endif

        end if

        ioo = 1


        return
        end



!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
        subroutine piY_coll( kl, kl1, ss, lc, tw, ioo )
!!      A part of "prod" to deal with pi + Y --> ...
!       Finds production and fills up lc(i,3-5), tw(i).
!       pion + Lambda/Sigma channels are defined as 35-48, 97-110.
!       kl, kl1: the KF code.
!       ss: the total energy (invariant mass) of two hadrons.
!       lc: collision list.
!       tw: the ratio of cross section of (special inela.)/tot.
!       ioo: flag of elastic (0) and inelastic (1) treatment.
        IMPLICIT DOUBLE PRECISION(A-H, O-Z)
        IMPLICIT INTEGER(I-N)
        INTEGER PYCOMP
        COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4)
        common/sa10_h/csnn,cspin,cskn,cspipi,cspsn,cspsm,rcsit,ifram, &
         iabsb,iabsm,i_sigma_AQM,csspn,csspm
        common/sa20_h/t0,cspipiKK,dep,ddt,edipi,epin,ecsnn,ekn,ecspsn,ecspsm, &
         rnt,rnp,ecsspn,ecsspm
        common/iloval/ilo1,ilo2,ilo3,ilo4,ilo5,ilo6,ilo7,ilo8,ilo9
        common/count_h/isinel(2000)
        integer :: lc(6)


        ioo = 0

!       pi + Lambda
        if( ABS(kl1) == 3122 )then

!       pion+ + lambda0
            if(kl == 211 .and. kl1 == 3122)then
                if(isinel(99) == 0)then
                    sigma1=0D0
                    goto 2522
                endif
                the=PMAS(PYCOMP(321),1)+PMAS(PYCOMP(3322),1)
                sigma1=s1724(ss,ilo1,0,the)
!       pion+ + lambda0 to k+ + cascade
2522            if(isinel(252) == 0)then
                    sigma2=0D0
                    goto 2523
                endif
                ik3=-311
                ik4=2212
                call srev(kl,kl1,ik3,ik4,ss,ilo2,fac, &
                 1.,0.,0.,0.5,0.5,0.5,0.,0.5,1.)
                the=PMAS(PYCOMP(-311),1)+PMAS(PYCOMP(2212),1)
                sigma2=fac*s1724(ss,ilo2,0,the)*10D0
!       cross section of pion+ + lambda0 to k0- + p
2523            if(ilo1 == 0.and.ilo2 == 0) return
                if(sigma1 < 1D-6 .and. sigma2 < 1D-6) return
                ik1=321
                ik2=3322
                ic=99
!       pion+ + lambda0 to k+ + cascade0
                sigm12=sigma1+sigma2
                if(PYR(1) > sigma1/sigm12)then
                    ik1=-311
                    ik2=2212
                    ic=252
!       cross section of pion+ + lambda0 to k0- + p
                endif
                lc(3)=ik1
                lc(4)=ik2
                lc(5)=ic
                tw=sigm12/cspin/10D0

!       pion- + lambda0-
            else if(kl == -211 .and. kl1 == -3122)then
                if(isinel(107) == 0)then
                    sigma1=0D0
                    goto 3522
                endif
                the=PMAS(PYCOMP(-321),1)+PMAS(PYCOMP(-3322),1)
                sigma1=s1724(ss,ilo1,0,the)
!       pion- + lambda- to k- + cascade0-
3522            if(isinel(275) == 0)then
                    sigma2=0D0
                    goto 3523
                endif
                ik3=311
                ik4=-2212
                call srev(kl,kl1,ik3,ik4,ss,ilo2,fac, &
                 1.,0.,0.,0.5,0.5,0.5,0.,0.5,1.)
                the=PMAS(PYCOMP(311),1)+PMAS(PYCOMP(-2212),1)
                sigma2=fac*s1724(ss,ilo2,0,the)*10D0
!       pion- + lambda0- to k0 + pba
3523            if(ilo1 == 0.and.ilo2 == 0) return
                if(sigma1 < 1D-6 .and. sigma2 < 1D-6) return
                ik1=-321
                ik2=-3322
                ic=107
!       pion- + lambda- to k- + cascade0-
                sigm12=sigma1+sigma2
                if(PYR(1) > sigma1/sigm12)then
                    ik1=311
                    ik2=-2212
                    ic=275
!       pion- + lambda0- to k0 + pba
                endif
                lc(3)=ik1
                lc(4)=ik2
                lc(5)=ic
                tw=sigm12/cspin/10D0

!       pion- + lambda0
            else if(kl == -211 .and. kl1 == 3122)then
                if(isinel(36) == 0)then
                    sigma1=0D0
                    goto 1522
                endif
                the=PMAS(PYCOMP(311),1)+PMAS(PYCOMP(3312),1)
                sigma1=s1724(ss,ilo1,0,the)
!       pion- + lambda to k0 + cascade-
1522            if(isinel(258) == 0)then
                    sigma2=0D0
                    goto 1523
                endif
                ik3=-321
                ik4=2112
                call srev(kl,kl1,ik3,ik4,ss,ilo2,fac, &
                1.,0.,0.,0.5,0.5,0.5,0.,0.5,1.)
                the=PMAS(PYCOMP(-321),1)+PMAS(PYCOMP(2112),1)
                sigma2=fac*s1724(ss,ilo2,0,the)*10D0
!       cross section of   pion- + lambda0 to k- + n
1523            if(ilo1 == 0.and.ilo2 == 0) return
                if(sigma1 < 1D-6 .and. sigma2 < 1D-6)  return
                ik1=311
                ik2=3312
                ic=36
!       pion- + lambda to k0 + cascade-
                sigm12=sigma1+sigma2
                if(PYR(1) > sigma1/sigm12)then
                    ik1=-321
                    ik2=2112
                    ic=258
!       cross section of pion- + lambda0 to k- + n
                endif
                lc(3)=ik1
                lc(4)=ik2
                lc(5)=ic
                tw=sigm12/cspin/10D0

!       pion+ + lambda-
            else if(kl == 211 .and. kl1 == -3122)then
                if(isinel(42) == 0)then
                    sigma1=0D0
                    goto 6522
                endif
                the=PMAS(PYCOMP(-311),1)+PMAS(PYCOMP(-3312),1)
                sigma1=s1724(ss,ilo1,0,the)
!       pion+ + lambdaba to k0- + cascade-ba
6522            if(isinel(269) == 0)then
                    sigma2=0D0
                    goto 6523
                endif
                ik3=321
                ik4=-2112
                call srev(kl,kl1,ik3,ik4,ss,ilo2,fac, &
                1.,0.,0.,0.5,0.5,0.5,0.,0.5,1.)
                the=PMAS(PYCOMP(321),1)+PMAS(PYCOMP(-2112),1)
                sigma2=fac*s1724(ss,ilo2,0,the)*10D0
!       pion+ + lambda0- to k+ + nba
6523            if(ilo1 == 0.and.ilo2 == 0) return
                if(sigma1 < 1D-6 .and. sigma2 < 1D-6) return
                ik1=-311
                ik2=-3312
                ic=42
!       pion+ + lambdaba to k0- + cascade-ba
                sigm12=sigma1+sigma2
                if(PYR(1) > sigma1/sigm12)then
                    ik1=321
                    ik2=-2112
                    ic=269
!       pion+ + lambda0- to k+ + nba
                endif
                lc(3)=ik1
                lc(4)=ik2
                lc(5)=ic
                tw=sigm12/cspin/10D0

!       pion0 + lambda0
            else if(kl == 111 .and. kl1 == 3122)then
                if(isinel(263) == 0)then
                    si1=0D0
                    goto 669
                endif
                ik1=-321
                ik2=2212
                call srev(kl,kl1,ik1,ik2,ss,ilo1,fac, &
                1.,0.,0.,0.5,0.5,0.5,0.,0.5,1.)
                the=PMAS(PYCOMP(-321),1)+PMAS(PYCOMP(2212),1)
                si1=10D0*s1724(ss,ilo1,0,the)*fac
669             if(isinel(264) == 0)then
                    si2=0D0
                    goto 670
                endif
                ik1=-311
                ik2=2112
                call srev(kl,kl1,ik1,ik2,ss,ilo2,fac, &
                1.,0.,0.,0.5,0.5,0.5,0.,0.5,1.)
                the=PMAS(PYCOMP(-311),1)+PMAS(PYCOMP(2112),1)
                si2=10D0*s1724(ss,ilo2,0,the)*fac
670             if(isinel(39) == 0)then
                    si3=0D0
                    goto 1670
                endif
                the=PMAS(PYCOMP(321),1)+PMAS(PYCOMP(3312),1)
                si3=s1724(ss,ilo3,0,the)
1670            if(isinel(103) == 0)then
                    si4=0D0
                    goto 1671
                endif
                the=PMAS(PYCOMP(311),1)+PMAS(PYCOMP(3322),1)
                si4=s1724(ss,ilo4,0,the)
1671            if(ilo1 == 0.and.ilo2 == 0.and.ilo3 == 0.and.ilo4 == 0) return
                if(si1 < 1D-6.and.si2 < 1D-6.and.si3 < 1D-6 &
                .and.si4 < 1D-6) return
                si12=si1+si2
                si13=si12+si3
                si14=si13+si4
                s1=si1/si14
                s2=si12/si14
                s3=si13/si14
                rlus=PYR(1)
                if(rlus <= s1)then
                    ik1=-321
                    ik2=2212
                    ic=263
!       pion0 + lambda0 to k- + p
                    goto 671
                endif
                if(rlus > s1 .and. rlus <= s2)then
                    ik1=-311
                    ik2=2112
                    ic=264
!       pion0 + lambda0 to k0- + n
                    goto 671
                endif
                if(rlus > s2 .and. rlus <= s3)then
                    ik1=321
                    ik2=3312
                    ic=39
!       pion0 + lambda0 to  k+ + cascade-
                    goto 671
                endif
                ik1=311
                ik2=3322
                ic=103
!       pion0 + lambda to k0 + cascade0
671             lc(3)=ik1
                lc(4)=ik2
                lc(5)=ic
                tw=si14/cspin/10D0

!       pion0 + lambda0-
            else if(kl == 111 .and. kl1 == -3122)then
                if(isinel(280) == 0)then
                    si1=0.
                    goto 2669
                endif
                ik1=321
                ik2=-2212
                call srev(kl,kl1,ik1,ik2,ss,ilo1,fac, &
                1.,0.,0.,0.5,0.5,0.5,0.,0.5,1.)
                the=PMAS(PYCOMP(321),1)+PMAS(PYCOMP(-2212),1)
                si1=10D0*s1724(ss,ilo1,0,the)*fac
2669            if(isinel(281) == 0)then
                    si2=0D0
                    goto 2677
                endif
                ik1=311
                ik2=-2112
                call srev(kl,kl1,ik1,ik2,ss,ilo2,fac, &
                1.,0.,0.,0.5,0.5,0.5,0.,0.5,1.)
                the=PMAS(PYCOMP(311),1)+PMAS(PYCOMP(-2112),1)
                si2=10D0*s1724(ss,ilo2,0,the)*fac
2677            if(isinel(46) == 0)then
                    si3=0D0
                    goto 2670
                endif
                the=PMAS(PYCOMP(-321),1)+PMAS(PYCOMP(-3312),1)
                si3=s1724(ss,ilo3,0,the)
!       pion0 + lambda- to k- + cascade-ba
2670            if(isinel(110) == 0)then
                    si4=0.
                    goto 2671
                endif
                the=PMAS(PYCOMP(-311),1)+PMAS(PYCOMP(-3322),1)
                si4=s1724(ss,ilo4,0,the)
2671            if(ilo1 == 0.and.ilo2 == 0.and.ilo3 == 0.and.ilo4 == 0) return
                if(si1 < 1D-6.and.si2 < 1D-6.and.si3 < 1D-6 &
                .and.si4 < 1D-6) return
                si12=si1+si2
                si13=si12+si3
                si14=si13+si4
                s1=si1/si14
                s2=si12/si14
                s3=si13/si14
                rlus=PYR(1)
                if(rlus <= s1)then
                    ik1=321
                    ik2=-2212
                    ic=280
!       pion0 + lambda0- to k+ + pbar
                    goto 6711
                endif
                if(rlus > s1 .and. rlus <= s2)then
                    ik1=311
                    ik2=-2112
                    ic=281
!       pion0 + lambda0- to k0 + nba
                    goto 6711
                endif
                if(rlus > s2 .and. rlus <= s3)then
                    ik1=-321
                    ik2=-3312
                    ic=46
!       pion0 + lambda- to k- + cascade-ba
                    goto 6711
                endif
                ik1=-311
                ik2=-3322
                ic=110
!       pion0 + lambda- to k0- + cascade0-
6711            lc(3)=ik1
                lc(4)=ik2
                lc(5)=ic
                tw=si14/cspin/10D0

            else
                write(*,*) "Warning! piY_coll-Lambda: some channels " &
                        // "are missing. KF1, KF2 =", kl, kl1
                return
            endif

!       pi + Sigma
        else

!       pion+ + sigma-
            if(kl == 211 .and. kl1 == 3112)then
                if(isinel(35) == 0)then
                    si1=0D0
                    goto 701
                endif
                the=PMAS(PYCOMP(321),1)+PMAS(PYCOMP(3312),1)
                si1=s1724(ss,ilo1,0,the)
!       cross section of pion + Y to Kaon + Cascade is assumed to be
!        equal to pion + n to Kaon + Y,but take the different of
!        threshold energy into account
701             if(isinel(97) == 0)then
                    si2=0D0
                    goto 660
                endif
                the=PMAS(PYCOMP(311),1)+PMAS(PYCOMP(3322),1)
                si2=s1724(ss,ilo2,0,the)
660             if(isinel(249) == 0)then
                    si3=0D0
                    goto 661
                endif
                the=PMAS(PYCOMP(-321),1)+PMAS(PYCOMP(2212),1)
                ik1=-321
                ik2=2212
                call srev(kl,kl1,ik1,ik2,ss,ilo3,fac, &
                 1.,1.,0.,0.5,0.5,0.5,0.,0.5,1.)
                si3=10D0*s1724(ss,ilo3,0,the)*fac
661             if(isinel(250) == 0)then
                    si4=0D0
                    goto 702
                endif
                the=PMAS(PYCOMP(-311),1)+PMAS(PYCOMP(2112),1)
                ik1=-311
                ik2=2112
                call srev(kl,kl1,ik1,ik2,ss,ilo4,fac, &
                 1.,1.,0.,0.5,0.5,0.5,0.,0.5,1.)
                si4=10D0*s1724(ss,ilo4,0,the)*fac
702             if(ilo1 == 0.and.ilo2 == 0.and.ilo3 == 0.and.ilo4 == 0) return
                if(si1 < 1D-6.and.si2 < 1D-6.and.si3 < 1D-6.and. &
                 si4 < 1D-6) return
                si12=si1+si2
                si13=si12+si3
                si14=si13+si4
                s1=si1/si14
                s2=si12/si14
                s3=si13/si14
                rlus=PYR(1)
                if(rlus <= s1)then
                    ik1=321
                    ik2=3312
                    ic=35
!       pion+ + sigma- to k+ + cascade-
                    goto 703
                endif
                if(rlus > s1 .and. rlus <= s2)then
                    ik1=311
                    ik2=3322
                    ic=97
!       pion+ + sigma- to k0 + cascade0
                    goto 703
                endif
                if(rlus > s2 .and. rlus <= s3)then
                    ik1=-321
                    ik2=2212
                    ic=249
!       pion+ + sigma- to k- + p
                    goto 703
                endif
                ik1=-311
                ik2=2112
                ic=250
!       pion+ + sigma- to k0- + n
703             lc(3)=ik1
                lc(4)=ik2
                lc(5)=ic
                tw=si14/cspin/10D0

!       pion- + sigma-ba
            else if(kl == -211 .and. kl1 == -3112)then
                if(isinel(45) == 0)then
                    si1=0D0
                    goto 7011
                endif
                the=PMAS(PYCOMP(-321),1)+PMAS(PYCOMP(-3312),1)
                si1=s1724(ss,ilo1,0,the)
!       cross section of pion + Y to Kaon + cascade is assumed to be
!        equal to pion + n to Kaon + Y,but take the different of
!        threshold energy into account
7011            if(isinel(105) == 0)then
                    si2=0D0
                    goto 6601
                endif
                the=PMAS(PYCOMP(-311),1)+PMAS(PYCOMP(-3322),1)
                si2=s1724(ss,ilo2,0,the)
6601            if(isinel(271) == 0)then
                    si3=0D0
                    goto 6611
                endif
                the=PMAS(PYCOMP(321),1)+PMAS(PYCOMP(-2212),1)
                ik1=321
                ik2=-2212
                call srev(kl,kl1,ik1,ik2,ss,ilo3,fac, &
                 1.,1.,0.,0.5,0.5,0.5,0.,0.5,1.)
                si3=10D0*s1724(ss,ilo3,0,the)*fac
6611            if(isinel(272) == 0)then
                    si4=0D0
                    goto 7021
                endif
                the=PMAS(PYCOMP(311),1)+PMAS(PYCOMP(-2112),1)
                ik1=311
                ik2=-2112
                call srev(kl,kl1,ik1,ik2,ss,ilo4,fac, &
                 1.,1.,0.,0.5,0.5,0.5,0.,0.5,1.)
                si4=10D0*s1724(ss,ilo4,0,the)*fac
7021            if(ilo1 == 0.and.ilo2 == 0.and.ilo3 == 0 &
                 .and.ilo4 == 0) return
                if(si1 < 1D-6.and.si2 < 1D-6.and.si3 < 1D-6 &
                 .and.si4 < 1D-6) return
                si12=si1+si2
                si13=si12+si3
                si14=si13+si4
                s1=si1/si14
                s2=si12/si14
                s3=si13/si14
                rlus=PYR(1)
                if(rlus <= s1)then
                    ik1=-321
                    ik2=-3312
                    ic=45
!       pion- + sigma-ba to k- + cascade-ba
                    goto 7031
                endif
                if(rlus > s1 .and. rlus <= s2)then
                ik1=-311
                ik2=-3322
                ic=105
!       pion- + sigma-ba to k0- + cascade0-
                    goto 7031
                endif
                if(rlus > s2 .and. rlus <= s3)then
                    ik1=321
                    ik2=-2212
                    ic=271
!       pion- + sigma-ba to k+ + pba
                    goto 7031
                endif
                ik1=311
                ik2=-2112
                ic=272
!       pion- + sigma-ba to k0 + nba
7031            lc(3)=ik1
                lc(4)=ik2
                lc(5)=ic
                tw=si14/cspin/10D0

!       pion- + sigma+
            else if(kl == -211 .and. kl1 == 3222)then
                if(isinel(37) == 0)then
                    si1=0D0
                    goto 704
                endif
                the=PMAS(PYCOMP(321),1)+PMAS(PYCOMP(3312),1)
                si1=s1724(ss,ilo1,0,the)
704             if(isinel(100) == 0)then
                    si2=0D0
                    goto 663
                endif
                the=PMAS(PYCOMP(311),1)+PMAS(PYCOMP(3322),1)
                si2=s1724(ss,ilo2,0,the)
663             if(isinel(254) == 0)then
                    si3=0D0
                    goto 664
                endif
                ik1=-321
                ik2=2212
                the=PMAS(PYCOMP(-321),1)+PMAS(PYCOMP(2212),1)
                call srev(kl,kl1,ik1,ik2,ss,ilo3,fac, &
                 1.,1.,0.,0.5,0.5,0.5,0.,0.5,1.)
                si3=10D0*s1724(ss,ilo3,0,the)*fac
664             if(isinel(255) == 0)then
                    si4=0D0
                    goto 705
                endif
                ik1=-311
                ik2=2112
                the=PMAS(PYCOMP(-311),1)+PMAS(PYCOMP(2112),1)
                call srev(kl,kl1,ik1,ik2,ss,ilo4,fac, &
                 1.,1.,0.,0.5,0.5,0.5,0.,0.5,1.)
                si4=10D0*s1724(ss,ilo4,0,the)*fac
705             if(ilo1 == 0.and.ilo2 == 0.and.ilo3 == 0.and.ilo4 == 0) return
                if(si1 < 1D-6.and.si2 < 1D-6.and.si3 < 1D-6 &
                 .and.si4 < 1D-6) return
                si12=si1+si2
                si13=si12+si3
                si14=si13+si4
                s1=si1/si14
                s2=si12/si14
                s3=si13/si14
                rlus=PYR(1)
                if(rlus <= s1)then
                    ik1=321
                    ik2=3312
                    ic=37
!       pion- + sigma+ to k+ + cascade-
                    goto 706
                endif
                if(rlus > s1 .and. rlus <= s2)then
                    ik1=311
                    ik2=3322
                    ic=100
!       pion- + sigma+ to k0 + cascade0
                    goto 706
                endif
                if(rlus > s2 .and. rlus <= s3)then
                    ik1=-321
                    ik2=2212
                    ic=254
!       pion- + sigma+ to k- + p
                    goto 706
                endif
                ik1=-311
                ik2=2112
                ic=255
!       pion- + sigma+ to k0- + n
706             lc(3)=ik1
                lc(4)=ik2
                lc(5)=ic
                tw=si14/cspin/10D0

!       pion+ + sigma+bar
            else if(kl == 211 .and. kl1 == -3222)then
                if(isinel(43) == 0)then
                    si1=0D0
                    goto 7041
                endif
                the=PMAS(PYCOMP(-321),1)+PMAS(PYCOMP(-3312),1)
                si1=s1724(ss,ilo1,0,the)
7041            if(isinel(104) == 0)then
                    si2=0D0
                    goto 6631
                endif
                the=PMAS(PYCOMP(-311),1)+PMAS(PYCOMP(-3322),1)
                si2=s1724(ss,ilo2,0,the)
6631            if(isinel(266) == 0)then
                    si3=0D0
                    goto 6641
                endif
                ik1=321
                ik2=-2212
                the=PMAS(PYCOMP(321),1)+PMAS(PYCOMP(-2212),1)
                call srev(kl,kl1,ik1,ik2,ss,ilo3,fac, &
                 1.,1.,0.,0.5,0.5,0.5,0.,0.5,1.)
                si3=10D0*s1724(ss,ilo3,0,the)*fac
6641            if(isinel(267) == 0)then
                    si4=0D0
                    goto 7051
                endif
                ik1=311
                ik2=-2112
                the=PMAS(PYCOMP(311),1)+PMAS(PYCOMP(-2112),1)
                call srev(kl,kl1,ik1,ik2,ss,ilo4,fac, &
                 1.,1.,0.,0.5,0.5,0.5,0.,0.5,1.)
                si4=10D0*s1724(ss,ilo4,0,the)*fac
7051            if(ilo1 == 0.and.ilo2 == 0.and.ilo3 == 0.and.ilo4 == 0) return
                if(si1 < 1D-6.and.si2 < 1D-6.and.si3 < 1D-6 &
                 .and.si4 < 1D-6) return
                si12=si1+si2
                si13=si12+si3
                si14=si13+si4
                s1=si1/si14
                s2=si12/si14
                s3=si13/si14
                rlus=PYR(1)
                if(rlus <= s1)then
                    ik1=-321
                    ik2=-3312
                    ic=43
!       pion+ + sigma+bar to k- + cascade-bar
                    goto 7061
                endif
                if(rlus > s1 .and. rlus <= s2)then
                    ik1=-311
                    ik2=-3322
                    ic=104
!       pion+ + sigma+bar to k0- + cascade0bar
                    goto 7061
                endif
                if(rlus > s2 .and. rlus <= s3)then
                    ik1=321
                    ik2=-2212
                    ic=266
!       pion+ + sigma+bar to k+ + pbar
                    goto 7061
                endif
                ik1=311
                ik2=-2112
                ic=267
!       pion+ + sigma+bar to k0 + nbar
7061            lc(3)=ik1
                lc(4)=ik2
                lc(5)=ic
                tw=si14/cspin/10D0

!       pion- + sigma0
            else if(kl == -211 .and. kl1 == 3212)then
                if(isinel(38) == 0)then
                    si1=0D0
                    goto 1681
                endif
                the=PMAS(PYCOMP(311),1)+PMAS(PYCOMP(3312),1)
                si1=s1724(ss,ilo1,0,the)
1681            if(isinel(256) == 0)then
                    si2=0D0
                    goto 1682
                endif
                the=PMAS(PYCOMP(-321),1)+PMAS(PYCOMP(2112),1)
                ik3=-321
                ik4=2112
                call srev(kl,kl1,ik3,ik4,ss,ilo2,fac, &
                 1.,1.,0.,0.5,0.5,0.5,0.,0.5,1.)
                si2=s1724(ss,ilo2,0,the)*10D0*fac
1682            if(ilo1 == 0.and.ilo2 == 0) return
                if(si1 < 1D-6.and.si2 < 1D-6) return
                sit=si1+si2
                s1=si1/sit
                rlus=PYR(1)
                if(rlus <= s1)then
                    ik1=311
                    ik2=3312
                    ic=38
!       pion- + sigma0 to k0 + cascade-
                    goto 683
                endif
                ik1=-321
                ik2=2112
                ic=256
!       pion- + sigma0 to k- + n
683             lc(3)=ik1
                lc(4)=ik2
                lc(5)=ic
                tw=sit/cspin/10D0

!       pion+ + sigma0 bar
            else if(kl == 211 .and. kl1 == -3212)then
                if(isinel(44) == 0)then
                    si1=0D0
                    goto 1781
                endif
                the=PMAS(PYCOMP(-311),1)+PMAS(PYCOMP(-3312),1)
                si1=s1724(ss,ilo1,0,the)
1781            if(isinel(268) == 0)then
                    si2=0D0
                    goto 1782
                endif
                the=PMAS(PYCOMP(321),1)+PMAS(PYCOMP(-2112),1)
                ik3=321
                ik4=-2112
                call srev(kl,kl1,ik3,ik4,ss,ilo2,fac, &
                 1.,1.,0.,0.5,0.5,0.5,0.,0.5,1.)
                si2=s1724(ss,ilo2,0,the)*10D0*fac
1782            if(ilo1 == 0.and.ilo2 == 0) return
                if(si1 < 1D-6.and.si2 < 1D-6) return
                sit=si1+si2
                s1=si1/sit
                rlus=PYR(1)
                if(rlus <= s1)then
                    ik1=-311
                    ik2=-3312
                    ic=44
!       pion+ + sigma0bar to k0- + cascade-bar
                    goto 6831
                endif
                ik1=321
                ik2=-2112
                ic=268
!       pion+ + sigma0bar to k+ + nbar
6831            lc(3)=ik1
                lc(4)=ik2
                lc(5)=ic
                tw=sit/cspin/10D0

!       pion0 + sigma0
            else if(kl == 111 .and. kl1 == 3212)then
                if(isinel(41) == 0)then
                    si1=0D0
                    goto 710
                endif
                the=PMAS(PYCOMP(321),1)+PMAS(PYCOMP(3312),1)
                si1=s1724(ss,ilo1,0,the)
710             if(isinel(102) == 0)then
                    si2=0D0
                    goto 666
                endif
                the=PMAS(PYCOMP(311),1)+PMAS(PYCOMP(3322),1)
                si2=s1724(ss,ilo2,0,the)
666             if(isinel(261) == 0)then
                    si3=0D0
                    goto 667
                endif
                the=PMAS(PYCOMP(-321),1)+PMAS(PYCOMP(2212),1)
                ik1=-321
                ik2=2212
                call srev(kl,kl1,ik1,ik2,ss,ilo3,fac, &
                 1.,1.,0.,0.5,0.5,0.5,0.,0.5,1.)
                si3=10D0*s1724(ss,ilo3,0,the)*fac
667             if(isinel(262) == 0)then
                    si4=0D0
                    goto 711
                endif
                the=PMAS(PYCOMP(-311),1)+PMAS(PYCOMP(2112),1)
                ik1=-311
                ik2=2112
                call srev(kl,kl1,ik1,ik2,ss,ilo4,fac, &
                 1.,1.,0.,0.5,0.5,0.5,0.,0.5,1.)
                si4=10D0*s1724(ss,ilo4,0,the)*fac
711             if(ilo1 == 0.and.ilo2 == 0.and.ilo3 == 0.and.ilo4 == 0) return
                if(si1 < 1D-6.and.si2 < 1D-6.and.si3 < 1D-6 &
                 .and.si4 < 1D-6) return
                si12=si1+si2
                si13=si12+si3
                si14=si13+si4
                s1=si1/si14
                s2=si12/si14
                s3=si13/si14
                rlus=PYR(1)
                if(rlus <= s1)then
                    ik1=321
                    ik2=3312
                    ic=41
!       pion0 + sigma0 to k+ + cascade-
                    goto 712
                endif
                if(rlus > s1 .and. rlus <= s2)then
                    ik1=311
                    ik2=3322
                    ic=102
!       pion0 + sigma0 to k0 + cascade0
                    goto 712
                endif
                if(rlus > s2 .and. rlus <= s3)then
                    ik1=-321
                    ik2=2212
                    ic=261
!      pion0 + sigma0 to k- + p
                    goto 712
                endif
                ik1=-311
                ik2=2112
                ic=262
!       pion0 + sigma0 to k0- + n
712             lc(3)=ik1
                lc(4)=ik2
                lc(5)=ic
                tw=si14/cspin/10D0

!       pion0 + sigma0bar
            else if(kl == 111 .and. kl1 == -3212)then
                if(isinel(48) == 0)then
                    si1=0D0
                    goto 1910
                endif
                the=PMAS(PYCOMP(-321),1)+PMAS(PYCOMP(-3312),1)
                si1=s1724(ss,ilo1,0,the)
1910            if(isinel(109) == 0)then
                    si2=0D0
                    goto 1666
                endif
                the=PMAS(PYCOMP(-311),1)+PMAS(PYCOMP(-3322),1)
                si2=s1724(ss,ilo2,0,the)
1666            if(isinel(278) == 0)then
                    si3=0D0
                    goto 1667
                endif
                the=PMAS(PYCOMP(321),1)+PMAS(PYCOMP(-2212),1)
                ik1=321
                ik2=-2212
                call srev(kl,kl1,ik1,ik2,ss,ilo3,fac, &
                 1.,1.,0.,0.5,0.5,0.5,0.,0.5,1.)
                si3=10D0*s1724(ss,ilo3,0,the)*fac
1667            if(isinel(279) == 0)then
                    si4=0D0
                    goto 5711
                endif
                the=PMAS(PYCOMP(311),1)+PMAS(PYCOMP(-2112),1)
                ik1=311
                ik2=-2112
                call srev(kl,kl1,ik1,ik2,ss,ilo4,fac, &
                 1.,1.,0.,0.5,0.5,0.5,0.,0.5,1.)
                si4=10D0*s1724(ss,ilo4,0,the)*fac
5711            if(ilo1 == 0.and.ilo2 == 0.and.ilo3 == 0.and.ilo4 == 0) return
                if(si1 < 1D-6.and.si2 < 1D-6.and.si3 < 1D-6 &
                 .and.si4 < 1D-6) return
                si12=si1+si2
                si13=si12+si3
                si14=si13+si4
                s1=si1/si14
                s2=si12/si14
                s3=si13/si14
                rlus=PYR(1)
                if(rlus <= s1)then
                    ik1=-321
                    ik2=-3312
                    ic=48
!       pion0 + sigma0bar to k- + cascade-bar
                    goto 7125
                endif
                if(rlus > s1 .and. rlus <= s2)then
                    ik1=-311
                    ik2=-3322
                    ic=109
!       pion0 + sigma0bar to k0- + cascade0bar
                    goto 7125
                endif
                if(rlus > s2 .and. rlus <= s3)then
                    ik1=321
                    ik2=-2212
                    ic=278
!      pion0 + sigma0bar to k+ + pbar
                    goto 7125
                endif
                ik1=311
                ik2=-2112
                ic=279
!       pion0 + sigma0bar to k0 + nbar
7125            lc(3)=ik1
                lc(4)=ik2
                lc(5)=ic
                tw=si14/cspin/10D0

!       pion+ + sigma0
            else if(kl == 211 .and. kl1 == 3212)then
                if(isinel(98) == 0)then
                    si1=0D0
                    goto 2681
                endif
                the=PMAS(PYCOMP(321),1)+PMAS(PYCOMP(3322),1)
                si1=s1724(ss,ilo1,0,the)
2681            if(isinel(251) == 0)then
                    si2=0D0
                    goto 2682
                endif
                the=PMAS(PYCOMP(-311),1)+PMAS(PYCOMP(2212),1)
                ik3=-311
                ik4=2212
                call srev(kl,kl1,ik3,ik4,ss,ilo2,fac, &
                 1.,1.,0.,0.5,0.5,0.5,0.,0.5,1.)
                si2=s1724(ss,ilo2,0,the)*10D0*fac
2682            if(ilo1 == 0.and.ilo2 == 0) return
                if(si1 < 1D-6.and.si2 < 1D-6) return
                sit=si1+si2
                s1=si1/sit
                rlus=PYR(1)
                if(rlus <= s1)then
                    ik1=321
                    ik2=3322
                    ic=98
!       pion+ + sigma0 to k+ + cacade0
                    goto 1683
                endif
                ik1=-311
                ik2=2212
                ic=251
!       pion+ + sigma0 to k0- + p
1683            lc(3)=ik1
                lc(4)=ik2
                lc(5)=ic
                tw=sit/cspin/10D0

!       pion- + sigma0-
            else if(kl == -211 .and. kl1 == -3212)then
                if(isinel(106) == 0)then
                    si1=0D0
                    goto 2781
                endif
                the=PMAS(PYCOMP(-321),1)+PMAS(PYCOMP(-3322),1)
                si1=s1724(ss,ilo1,0,the)
2781            if(isinel(273) == 0)then
                    si2=0D0
                    goto 2782
                endif
                the=PMAS(PYCOMP(311),1)+PMAS(PYCOMP(-2212),1)
                ik3=311
                ik4=-2212
                call srev(kl,kl1,ik3,ik4,ss,ilo2,fac, &
                 1.,1.,0.,0.5,0.5,0.5,0.,0.5,1.)
                si2=s1724(ss,ilo2,0,the)*10D0*fac
2782            if(ilo1 == 0.and.ilo2 == 0) return
                if(si1 < 1D-6.and.si2 < 1D-6) return
                sit=si1+si2
                s1=si1/sit
                rlus=PYR(1)
                if(rlus <= s1)then
                    ik1=-321
                    ik2=-3322
                    ic=106
!       pion- + sigma0- to k- + cacade0-
                    goto 1783
                endif
                ik1=311
                ik2=-2212
                ic=273
!       pion- + sigma0- to k0 + pba
1783            lc(3)=ik1
                lc(4)=ik2
                lc(5)=ic
                tw=sit/cspin/10D0

!       pion0 + sigma+
            else if(kl == 111 .and. kl1 == 3222)then
                if(isinel(101) == 0)then
                    si1=0D0
                    goto 3681
                endif
                the=PMAS(PYCOMP(321),1)+PMAS(PYCOMP(3322),1)
                si1=s1724(ss,ilo1,0,the)
3681            if(isinel(259) == 0)then
                    si2=0D0
                    goto 3682
                endif
                the=PMAS(PYCOMP(-311),1)+PMAS(PYCOMP(2212),1)
                ik3=-311
                ik4=2212
                call srev(kl,kl1,ik3,ik4,ss,ilo2,fac, &
                 1.,1.,0.,0.5,0.5,0.5,0.,0.5,1.)
                si2=s1724(ss,ilo2,0,the)*10D0*fac
3682            if(ilo1 == 0.and.ilo2 == 0) return
                if(si1 < 1D-6.and.si2 < 1D-6) return
                sit=si1+si2
                s1=si1/sit
                rlus=PYR(1)
                if(rlus <= s1)then
                    ik1=321
                    ik2=3322
                    ic=101
!       pion0 + sigma+ to k+ + cascade0
                    goto 7683
                endif
                ik1=-311
                ik2=2212
                ic=259
!       pion0 + sigma+ to k0- + p
7683            lc(3)=ik1
                lc(4)=ik2
                lc(5)=ic
                tw=sit/cspin/10D0

!       pion0 + sigma+bar
            else if(kl == 111 .and. kl1 == -3222)then
                if(isinel(108) == 0)then
                    si1=0D0
                    goto 3781
                endif
                the=PMAS(PYCOMP(-321),1)+PMAS(PYCOMP(-3322),1)
                si1=s1724(ss,ilo1,0,the)
3781            if(isinel(276) == 0)then
                    si2=0D0
                    goto 3782
                endif
                the=PMAS(PYCOMP(311),1)+PMAS(PYCOMP(-2212),1)
                ik3=311
                ik4=-2212
                call srev(kl,kl1,ik3,ik4,ss,ilo2,fac, &
                 1.,1.,0.,0.5,0.5,0.5,0.,0.5,1.)
                si2=s1724(ss,ilo2,0,the)*10D0*fac
3782            if(ilo1 == 0.and.ilo2 == 0) return
                if(si1 < 1D-6.and.si2 < 1D-6) return
                sit=si1+si2
                s1=si1/sit
                rlus=PYR(1)
                if(rlus <= s1)then
                    ik1=-321
                    ik2=-3322
                    ic=108
!       pion0 + sigma+bar to k- + cascade0bar
                    goto 6783
                endif
                ik1=311
                ik2=-2212
                ic=276
!       pion0 + sigma+bar to k0 + pbar
6783            lc(3)=ik1
                lc(4)=ik2
                lc(5)=ic
                tw=sit/cspin/10D0

!       pion0 + sigma-
            else if(kl == 111 .and. kl1 == 3112)then
                if(isinel(40) == 0)then
                    si1=0D0
                    goto 4681
                endif
                the=PMAS(PYCOMP(311),1)+PMAS(PYCOMP(3312),1)
                si1=s1724(ss,ilo1,0,the)
4681            if(isinel(260) == 0)then
                    si2=0D0
                    goto 4682
                endif
                the=PMAS(PYCOMP(-321),1)+PMAS(PYCOMP(2112),1)
                ik3=-321
                ik4=2112
                call srev(kl,kl1,ik3,ik4,ss,ilo2,fac, &
                 1.,1.,0.,0.5,0.5,0.5,0.,0.5,1.)
                si2=s1724(ss,ilo2,0,the)*10D0*fac
4682            if(ilo1 == 0.and.ilo2 == 0) return
                if(si1 < 1D-6.and.si2 < 1D-6) return
                sit=si1+si2
                s1=si1/sit
                rlus=PYR(1)
                if(rlus <= s1)then
                    ik1=311
                    ik2=3312
                    ic=40
!       pion0 + sigma- to k0+cascade-
                    goto 2683
                endif
                ik1=-321
                ik2=2112
                ic=260
!       pion0 + sigma- to k- + n
2683            lc(3)=ik1
                lc(4)=ik2
                lc(5)=ic
                tw=sit/cspin/10D0

!       pion0 + sigma-bar
            else if(kl == 111 .and. kl1 == -3112)then
                if(isinel(47) == 0)then
                    si1=0D0
                    goto 7681
                endif
                the=PMAS(PYCOMP(-311),1)+PMAS(PYCOMP(-3312),1)
                si1=s1724(ss,ilo1,0,the)
7681            if(isinel(277) == 0)then
                    si2=0D0
                    goto 7682
                endif
                the=PMAS(PYCOMP(321),1)+PMAS(PYCOMP(-2112),1)
                ik3=321
                ik4=-2112
                call srev(kl,kl1,ik3,ik4,ss,ilo2,fac, &
                 1.,1.,0.,0.5,0.5,0.5,0.,0.5,1.)
                si2=s1724(ss,ilo2,0,the)*10D0*fac
7682            if(ilo1 == 0.and.ilo2 == 0) return
                if(si1 < 1D-6.and.si2 < 1D-6) return
                sit=si1+si2
                s1=si1/sit
                rlus=PYR(1)
                if(rlus <= s1)then
                    ik1=-311
                    ik2=-3312
                    ic=47
!       pion0 + sigma-bar to k0- +cascade-bar
                    goto 7688
                endif
                ik1=321
                ik2=-2112
                ic=277
!       pion0 + sigma-bar to k+ + nbar
7688            lc(3)=ik1
                lc(4)=ik2
                lc(5)=ic
                tw=sit/cspin/10D0

            else
                write(*,*) "Warning! piY_coll-Sigma: some channels " &
                        // "are missing. KF1, KF2 =", kl, kl1
                return
            endif

        end if

        ioo = 1


        return
        end



!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
        subroutine piCascade_coll( kl, kl1, ss, lc, tw, ioo )
!!      A part of "prod" to deal with pi + Cascade --> ...
!       Finds production and fills up lc(i,3-5), tw(i).
!       pion + Cascade channels are defined as 131-138, 283-296, 311-324.
!       kl, kl1: the KF code.
!       ss: the total energy (invariant mass) of two hadrons.
!       lc: collision list.
!       tw: the ratio of cross section of (special inela.)/tot.
!       ioo: flag of elastic (0) and inelastic (1) treatment.
        IMPLICIT DOUBLE PRECISION(A-H, O-Z)
        IMPLICIT INTEGER(I-N)
        INTEGER PYCOMP
        COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4)
        common/sa10_h/csnn,cspin,cskn,cspipi,cspsn,cspsm,rcsit,ifram, &
         iabsb,iabsm,i_sigma_AQM,csspn,csspm
        common/sa20_h/t0,cspipiKK,dep,ddt,edipi,epin,ecsnn,ekn,ecspsn,ecspsm, &
         rnt,rnp,ecsspn,ecsspm
        common/iloval/ilo1,ilo2,ilo3,ilo4,ilo5,ilo6,ilo7,ilo8,ilo9
        common/count_h/isinel(2000)
        integer :: lc(6)


        ioo = 0
        ilo = 1

!       pion + Cascade
        if( kl1 > 0 )then

!       pion+ + cascade-
            if(kl == 211 .and. kl1 == 3312)then
                if(isinel(283) == 0)then
                    si1=0D0
                    goto 684
                endif
                ik1=-321
                ik2=3222
                call srev(kl,kl1,ik1,ik2,ss,ilo1,fac, &
                 1.,0.5,0.,0.5,0.5,1.,0.,0.5,1.)
                the=PMAS(PYCOMP(-321),1)+PMAS(PYCOMP(3222),1)
                si1=10D0*s1724(ss,ilo1,0,the)*fac
684             if(isinel(284) == 0)then
                    si2=0D0
                    goto 685
                endif
                ik1=-311
                ik2=3122
                call srev(kl,kl1,ik1,ik2,ss,ilo2,fac, &
                 1.,0.5,0.,0.5,0.5,0.,0.,0.5,1.)
                the=PMAS(PYCOMP(-311),1)+PMAS(PYCOMP(3122),1)
                si2=10D0*s1724(ss,ilo2,0,the)*fac
685             if(isinel(285) == 0)then
                    si3=0D0
                    goto 686
                endif
                ik1=-311
                ik2=3212
                call srev(kl,kl1,ik1,ik2,ss,ilo3,fac, &
                 1.,0.5,0.,0.5,0.5,1.,0.,0.5,1.)
                the=PMAS(PYCOMP(-311),1)+PMAS(PYCOMP(3212),1)
                si3=10D0*s1724(ss,ilo3,0,the)*fac
686             if(isinel(131) == 0)then
                    si4=0D0
                    goto 1686
                endif
                the=PMAS(PYCOMP(321),1)+PMAS(PYCOMP(3334),1)
                si4=s1724(ss,ilo4,0,the)
1686            if(ilo1 == 0 .and. ilo2 == 0 .and. ilo3 == 0 &
                    .and.ilo4 == 0) return
                if(si1 < 1D-6.and.si2 < 1D-6.and.si3 < 1D-6.and. &
                    si4 < 1D-6) return
                si12=si1+si2
                si13=si12+si3
                si14=si13+si4
                s1=si1/si14
                s2=si12/si14
                s3=si13/si14
                rlu1=PYR(1)
                if(rlu1 <= s1)then
                    ik1=-321
                    ik2=3222
                    ic=283
!       pion+ + cascade- to k- + sigma+
                    goto 687
                endif
                if(rlu1 > s1 .and. rlu1 <= s2)then
                    ik1=-311
                    ik2=3122
                    ic=284
!       pion+ + cascade- to k0- + lambda0
                    goto 687
                endif
                if(rlu1 > s2 .and. rlu1 <= s3)then
                    ik1=-311
                    ik2=3212
                    ic=285
!       pion+ + cascade- to k0- + sigma0
                    goto 687
                endif
                ik1=321
                ik2=3334
                ic=131
!       pion+ + cascade- to k+ + Omega-
687             lc(3)=ik1
                lc(4)=ik2
                lc(5)=ic
                tw=si14/cspin/10D0

!       pion- + cascade- to k- + sigma-
            else if(kl == -211 .and. kl1 == 3312)then
                if(isinel(286) == 0) return
                the=PMAS(PYCOMP(-321),1)+PMAS(PYCOMP(3112),1)
                ww=s1724(ss,ilo,0,the)/cspin
                if(ilo == 0) return
                lc(3)=-321
                lc(4)=3112
                lc(5)=286
                ik3=-321
                ik4=3112
                call srev(kl,kl1,ik3,ik4,ss,ilo1,fac, &
                 1.,0.5,0.,0.5,0.5,1.,0.,0.5,1.)
                tw=ww*fac

!       pion0 + cascade-
            else if(kl == 111 .and. kl1 == 3312)then
                if(isinel(287) == 0)then
                    si1=0D0
                    goto 688
                endif
                ik1=-321
                ik2=3122
                call srev(kl,kl1,ik1,ik2,ss,ilo1,fac, &
                 1.,0.5,0.,0.5,0.5,0.,0.,0.5,1.)
                the=PMAS(PYCOMP(-321),1)+PMAS(PYCOMP(3122),1)
                si1=10D0*s1724(ss,ilo1,0,the)*fac
688             if(isinel(288) == 0)then
                    si2=0D0
                    goto 689
                endif
                ik1=-321
                ik2=3212
                call srev(kl,kl1,ik1,ik2,ss,ilo2,fac, &
                 1.,0.5,0.,0.5,0.5,1.,0.,0.5,1.)
                the=PMAS(PYCOMP(-321),1)+PMAS(PYCOMP(3212),1)
                si2=10D0*s1724(ss,ilo2,0,the)*fac
689             if(isinel(289) == 0)then
                    si3=0D0
                    goto 690
                endif
                ik1=-311
                ik2=3112
                call srev(kl,kl1,ik1,ik2,ss,ilo3,fac, &
                 1.,0.5,0.,0.5,0.5,1.,0.,0.5,1.)
                the=PMAS(PYCOMP(-311),1)+PMAS(PYCOMP(3112),1)
                si3=10D0*s1724(ss,ilo3,0,the)*fac
690             if(isinel(132) == 0)then
                    si4=0D0
                    goto 1690
                endif
                the=PMAS(PYCOMP(311),1)+PMAS(PYCOMP(3334),1)
                si4=s1724(ss,ilo4,0,the)
!       pion0 + cascade- to k0 + Omega-
1690            if(ilo1 == 0 .and. ilo2 == 0 .and. ilo3 == 0.and. &
                    ilo4 == 0) return
                if(si1 < 1D-6.and.si2 < 1D-6.and.si3 < 1D-6.and. &
                    si4 < 1D-6) return
                si12=si1+si2
                si13=si12+si3
                si14=si13+si4
                s1=si1/si14
                s2=si12/si14
                s3=si13/si14
                rlu1=PYR(1)
                if(rlu1 <= s1)then
                    ik1=-321
                    ik2=3122
                    ic=287
!       pion0 + cascade- to k- + lambda0
                    goto 691
                endif
                if(rlu1 > s1 .and. rlu1 <= s2)then
                    ik1=-321
                    ik2=3212
                    ic=288
!       pion0 + cascade- to k- + sigma0
                    goto 691
                endif
                if(rlu1 > s2 .and. rlu1 <= s3)then
                    ik1=-311
                    ik2=3112
                    ic=289
!       pion0 + cascade- to k0- + sigma-
                    goto 691
                endif
                ik1=311
                ik2=3334
                ic=132
!       pion0 + cascade- to k0 + Omega-
691             lc(3)=ik1
                lc(4)=ik2
                lc(5)=ic
                tw=si14/cspin/10D0

!       pion+ + cascade0 to k0- + sigma+
            else if(kl == 211 .and. kl1 == 3322)then
                if(isinel(314) == 0) return
                the=PMAS(PYCOMP(-311),1)+PMAS(PYCOMP(3222),1)
                ww=s1724(ss,ilo,0,the)/cspin
                if(ilo == 0) return
                lc(3)=-311
                lc(4)=3222
                lc(5)=314
                ik3=-311
                ik4=3222
                call srev(kl,kl1,ik3,ik4,ss,ilo1,fac, &
                 1.0,0.5,0.,0.5,0.5,1.0,0.,0.5,1.)
                tw=ww*fac

!       pion- + cascade0
            else if(kl == -211 .and. kl1 == 3322)then
                if(isinel(312) == 0)then
                    si1=0D0
                    goto 808
                endif
                ik1=-321
                ik2=3212
                call srev(kl,kl1,ik1,ik2,ss,ilo1,fac, &
                 1.0,0.5,0.,0.5,0.5,1.0,0.,0.5,1.)
                the=PMAS(PYCOMP(-321),1)+PMAS(PYCOMP(3212),1)
                si1=10D0*s1724(ss,ilo1,0,the)*fac
808             if(isinel(313) == 0)then
                    si2=0D0
                    goto 809
                endif
                ik1=-321
                ik2=3122
                call srev(kl,kl1,ik1,ik2,ss,ilo2,fac, &
                 1.0,0.5,0.,0.5,0.5,0.0,0.,0.5,1.)
                the=PMAS(PYCOMP(-321),1)+PMAS(PYCOMP(3122),1)
                si2=10D0*s1724(ss,ilo2,0,the)*fac
809             if(isinel(315) == 0)then
                    si3=0D0
                    goto 810
                endif
                ik1=-311
                ik2=3112
                call srev(kl,kl1,ik1,ik2,ss,ilo3,fac, &
                 1.0,0.5,0.,0.5,0.5,1.0,0.,0.5,1.)
                the=PMAS(PYCOMP(-311),1)+PMAS(PYCOMP(3112),1)
                si3=10D0*s1724(ss,ilo3,0,the)*fac
810             if(isinel(135) == 0)then
                    si4=0D0
                    goto 1810
                endif
                the=PMAS(PYCOMP(311),1)+PMAS(PYCOMP(3334),1)
                si4=s1724(ss,ilo4,0,the)
1810            if(ilo1 == 0 .and. ilo2 == 0 .and. ilo3 == 0.and. &
                    ilo4 == 0) return
                if(si1 < 1D-6.and.si2 < 1D-6.and.si3 < 1D-6.and. &
                    si4 < 1D-6) return
                si12=si1+si2
                si13=si12+si3
                si14=si13+si4
                s1=si1/si14
                s2=si12/si14
                s3=si13/si14
                rlu1=PYR(1)
                if(rlu1 <= s1)then
                    ik1=-321
                    ik2=3212
                    ic=312
!       pion- + cascade0 to k- + sigma0
                    goto 811
                endif
                if(rlu1 > s1 .and. rlu1 <= s2)then
                    ik1=-321
                    ik2=3122
                    ic=313
!       pion- + cascade0 to k- + lambda
                    goto 811
                endif
                if(rlu1 > s2 .and. rlu1 <= s3)then
                    ik1=-311
                    ik2=3112
                    ic=315
!       pion- + cascade0 to k0- + sigma-
                    goto 811
                endif
                ik1=311
                ik2=3334
                ic=135
!       pion- + cascade0 to k0 + Omega-
811             lc(3)=ik1
                lc(4)=ik2
                lc(5)=ic
                tw=si14/cspin/10D0

!       pion0 + cascade0
            else if(kl == 111 .and. kl1 == 3322)then
                if(isinel(311) == 0)then
                    si1=0D0
                    goto 812
                endif
                ik1=-321
                ik2=3222
                call srev(kl,kl1,ik1,ik2,ss,ilo1,fac, &
                 1.0,0.5,0.,0.5,0.5,1.0,0.,0.5,1.)
                the=PMAS(PYCOMP(-321),1)+PMAS(PYCOMP(3222),1)
                si1=10D0*s1724(ss,ilo1,0,the)*fac
812             if(isinel(316) == 0)then
                    si2=0D0
                    goto 813
                endif
                ik1=-311
                ik2=3212
                call srev(kl,kl1,ik1,ik2,ss,ilo2,fac, &
                 1.0,0.5,0.,0.5,0.5,1.0,0.,0.5,1.)
                the=PMAS(PYCOMP(-311),1)+PMAS(PYCOMP(3212),1)
                si2=10D0*s1724(ss,ilo2,0,the)*fac
813             if(isinel(317) == 0)then
                    si3=0D0
                    goto 814
                endif
                ik1=-311
                ik2=3122
                call srev(kl,kl1,ik1,ik2,ss,ilo3,fac, &
                 1.0,0.5,0.,0.5,0.5,0.0,0.,0.5,1.)
                the=PMAS(PYCOMP(-311),1)+PMAS(PYCOMP(3122),1)
                si3=10D0*s1724(ss,ilo3,0,the)*fac
814             if(isinel(136) == 0)then
                    si4=0D0
                    goto 1814
                endif
                the=PMAS(PYCOMP(111),1)+PMAS(PYCOMP(2214),1)
                si4=s1724(ss,ilo4,0,the)
1814            if(ilo1 == 0 .and. ilo2 == 0 .and. ilo3 == 0 &
                    .and.ilo4 == 0) return
                if(si1 < 1D-6.and.si2 < 1D-6.and.si3 < 1D-6.and. &
                    si4 < 1D-6) return
                si12=si1+si2
                si13=si12+si3
                si14=si13+si4
                s1=si1/si14
                s2=si12/si14
                s3=si13/si14
                rlu1=PYR(1)
                if(rlu1 <= s1)then
                    ik1=-321
                    ik2=3222
                    ic=311
!       pion0 + cascade0 to k- + sigma+
                    goto 815
                endif
                if(rlu1 > s1 .and. rlu1 <= s2)then
                    ik1=-311
                    ik2=3212
                    ic=316
!       pion0 + cascade0 to k0- + sigma0
                    goto 815
                endif
                if(rlu1 > s2 .and. rlu1 <= s3)then
                    ik1=-311
                    ik2=3122
                    ic=317
!       pion0 + cascade0 to k0- + lambda
                    goto 815
                endif
                ik1=321
                ik2=3334
                ic=136
!       pion0 + cascade0 to k+ + Omega-
815             lc(3)=ik1
                lc(4)=ik2
                lc(5)=ic
                tw=si14/cspin/10D0

            else
                write(*,*) "Warning! piCascade_coll-Cacade: some channels " &
                        // "are missing. KF1, KF2 =", kl, kl1
                return
            end if

!       pion + Cascadebar
        else

!       pion+ + cascade-ba to k+ + sigma-ba
            if(kl == 211 .and. kl1 == -3312)then
                if(isinel(290) == 0) return
                the=PMAS(PYCOMP(321),1)+PMAS(PYCOMP(-3112),1)
                ww=s1724(ss,ilo,0,the)/cspin
                if(ilo == 0) return
                lc(3)=321
                lc(4)=-3112
                lc(5)=290
                ik3=321
                ik4=-3112
                call srev(kl,kl1,ik3,ik4,ss,ilo1,fac, &
                 1.,0.5,0.,0.5,0.5,1.,0.,0.5,1.)
                tw=ww*fac

!       pion- + cascade-ba
            else if(kl == -211 .and. kl1 == -3312)then
                if(isinel(291) == 0)then
                    si1=0D0
                    goto 692
                endif
                ik1=321
                ik2=-3222
                call srev(kl,kl1,ik1,ik2,ss,ilo1,fac, &
                 1.,0.5,0.,0.5,0.5,1.,0.,0.5,1.)
                the=PMAS(PYCOMP(321),1)+PMAS(PYCOMP(-3222),1)
                si1=10D0*s1724(ss,ilo1,0,the)*fac
692             if(isinel(292) == 0)then
                    si2=0D0
                    goto 693
                endif
                ik1=311
                ik2=-3122
                call srev(kl,kl1,ik1,ik2,ss,ilo2,fac, &
                 1.,0.5,0.,0.5,0.5,0.,0.,0.5,1.)
                the=PMAS(PYCOMP(311),1)+PMAS(PYCOMP(-3122),1)
                si2=10D0*s1724(ss,ilo2,0,the)*fac
693             if(isinel(293) == 0)then
                    si3=0D0
                    goto 694
                endif
                ik1=311
                ik2=-3212
                call srev(kl,kl1,ik1,ik2,ss,ilo3,fac, &
                 1.,0.5,0.,0.5,0.5,1.,0.,0.5,1.)
                the=PMAS(PYCOMP(311),1)+PMAS(PYCOMP(-3212),1)
                si3=10D0*s1724(ss,ilo3,0,the)*fac
694             if(isinel(133) == 0)then
                    si4=0D0
                    goto 1694
                endif
                the=PMAS(PYCOMP(-321),1)+PMAS(PYCOMP(-3334),1)
                si4=s1724(ss,ilo4,0,the)
1694            if(ilo1 == 0 .and. ilo2 == 0 .and. ilo3 == 0.and. &
                    ilo4 == 0) return
                if(si1 < 1D-6.and.si2 < 1D-6.and.si3 < 1D-6.and. &
                    si4 < 1D-6) return
                si12=si1+si2
                si13=si12+si3
                si14=si13+si4
                s1=si1/si14
                s2=si12/si14
                s3=si13/si14
                rlu1=PYR(1)
                if(rlu1 <= s1)then
                    ik1=321
                    ik2=-3222
                    ic=291
!       pion- + cascade-ba to k+ + sigma+-
                    goto 695
                endif
                if(rlu1 > s1 .and. rlu1 <= s2)then
                    ik1=311
                    ik2=-3122
                    ic=292
!       pion- + cascade-ba to k0 + lambda0-
                    goto 695
                endif
                if(rlu1 > s2 .and. rlu1 <= s3)then
                    ik1=311
                    ik2=-3212
                    ic=293
!       pion- + cascade-ba to k0 + sigma0-
                    goto 695
                endif
                ik1=-321
                ik2=-3334
                ic=133
!       pion- + cascade-ba to k- + Omega-ba
695             lc(3)=ik1
                lc(4)=ik2
                lc(5)=ic
                tw=si14/cspin/10D0

!       pion0 + cascade-ba
            else if(kl == 111 .and. kl1 == -3312)then
                if(isinel(294) == 0)then
                    si1=0.
                    goto 696
                endif
                ik1=321
                ik2=-3122
                call srev(kl,kl1,ik1,ik2,ss,ilo1,fac, &
                 1.,0.5,0.,0.5,0.5,0.,0.,0.5,1.)
                the=PMAS(PYCOMP(321),1)+PMAS(PYCOMP(-3122),1)
                si1=10D0*s1724(ss,ilo1,0,the)*fac
696             if(isinel(295) == 0)then
                    si2=0D0
                    goto 697
                endif
                ik1=321
                ik2=-3212
                call srev(kl,kl1,ik1,ik2,ss,ilo2,fac, &
                 1.,0.5,0.,0.5,0.5,1.,0.,0.5,1.)
                the=PMAS(PYCOMP(321),1)+PMAS(PYCOMP(-3212),1)
                si2=10D0*s1724(ss,ilo2,0,the)*fac
697             if(isinel(296) == 0)then
                    si3=0D0
                    goto 698
                endif
                ik1=311
                ik2=-3112
                call srev(kl,kl1,ik1,ik2,ss,ilo3,fac, &
                 1.,0.5,0.,0.5,0.5,1.,0.,0.5,1.)
                the=PMAS(PYCOMP(311),1)+PMAS(PYCOMP(-3112),1)
                si3=10D0*s1724(ss,ilo3,0,the)*fac
698             if(isinel(134) == 0)then
                    si4=0D0
                    goto 1698
                endif
                the=PMAS(PYCOMP(-311),1)+PMAS(PYCOMP(-3334),1)
                si4=s1724(ss,ilo4,0,the)
1698            if(ilo1 == 0 .and. ilo2 == 0 .and. ilo3 == 0.and. &
                    ilo4 == 0) return
                if(si1 < 1D-6.and.si2 < 1D-6.and.si3 < 1D-6.and. &
                    si4 < 1D-6) return
                si12=si1+si2
                si13=si12+si3
                si14=si13+si4
                s1=si1/si14
                s2=si12/si14
                s3=si13/si14
                rlu1=PYR(1)
                if(rlu1 <= s1)then
                    ik1=321
                    ik2=-3122
                    ic=294
!       pion0 + cascade-ba to k+ + lambda0-
                    goto 700
                endif
                if(rlu1 > s1 .and. rlu1 <= s2)then
                    ik1=321
                    ik2=-3212
                    ic=295
!       pion0 + cascade-ba to k+ + sigma0-
                    goto 700
                endif
                if(rlu1 > s2 .and. rlu1 <= s3)then
                    ik1=311
                    ik2=-3112
                    ic=296
!       pion0 + cascade-ba to k0 + sigma-ba
                    goto 700
                endif
                ik1=-311
                ik2=-3334
                ic=134
!       pion0 + cascade-ba to k0- + Omega-ba
700             lc(3)=ik1
                lc(4)=ik2
                lc(5)=ic
                tw=si14/cspin/10D0

!       pion+ + cascade0-
            else if(kl == 211 .and. kl1 == -3322)then
                if(isinel(319) == 0)then
                    si1=0D0
                    goto 804
                endif
                ik1=321
                ik2=-3212
                call srev(kl,kl1,ik1,ik2,ss,ilo1,fac, &
                 1.0,0.5,0.,0.5,0.5,1.0,0.,0.5,1.)
                the=PMAS(PYCOMP(321),1)+PMAS(PYCOMP(-3212),1)
                si1=10D0*s1724(ss,ilo1,0,the)*fac
804             if(isinel(320) == 0)then
                    si2=0D0
                    goto 805
                endif
                ik1=321
                ik2=-3122
                call srev(kl,kl1,ik1,ik2,ss,ilo2,fac, &
                 1.0,0.5,0.,0.5,0.5,0.0,0.,0.5,1.)
                the=PMAS(PYCOMP(321),1)+PMAS(PYCOMP(-3122),1)
                si2=10D0*s1724(ss,ilo2,0,the)*fac
805             if(isinel(322) == 0)then
                    si3=0D0
                    goto 806
                endif
                ik1=311
                ik2=-3112
                call srev(kl,kl1,ik1,ik2,ss,ilo3,fac, &
                 1.0,0.5,0.,0.5,0.5,1.0,0.,0.5,1.)
                the=PMAS(PYCOMP(311),1)+PMAS(PYCOMP(-3112),1)
                si3=10D0*s1724(ss,ilo3,0,the)*fac
806             if(isinel(137) == 0)then
                    si4=0D0
                    goto 1806
                endif
                the=PMAS(PYCOMP(-311),1)+PMAS(PYCOMP(-3334),1)
                si4=s1724(ss,ilo4,0,the)
1806            if(ilo1 == 0 .and. ilo2 == 0 .and. ilo3 == 0.and. &
                    ilo4 == 0) return
                if(si1 < 1D-6.and.si2 < 1D-6.and.si3 < 1D-6.and. &
                    si4 < 1D-6) return
                si12=si1+si2
                si13=si12+si3
                si14=si13+si4
                s1=si1/si14
                s2=si12/si14
                s3=si13/si14
                rlu1=PYR(1)
                if(rlu1 <= s1)then
                    ik1=321
                    ik2=-3212
                    ic=319
!       pion+ + cascade0- to k+ + sigma0-
                    goto 807
                endif
                if(rlu1 > s1 .and. rlu1 <= s2)then
                    ik1=321
                    ik2=-3122
                    ic=320
!       pion+ + cascade0- to k+ + lambda-
                    goto 807
                endif
                if(rlu1 > s2 .and. rlu1 <= s3)then
                    ik1=311
                    ik2=-3112
                    ic=322
!       pion+ + cascade0- to k0 + sigma-ba
                    goto 807
                endif
                ik1=-311
                ik2=-3334
                ic=137
!       pion+ + cascade0- to k0- + Omega-ba
807             lc(3)=ik1
                lc(4)=ik2
                lc(5)=ic
                tw=si14/cspin/10D0

!       pion- + cascade0- to k0 + sigma+ba
            else if(kl == -211 .and. kl1 == -3322)then
                if(isinel(321) == 0) return
                the=PMAS(PYCOMP(311),1)+PMAS(PYCOMP(-3222),1)
                ww=s1724(ss,ilo,0,the)/cspin
                if(ilo == 0) return
                lc(3)=311
                lc(4)=-3222
                lc(5)=321
                ik3=311
                ik4=-3222
                call srev(kl,kl1,ik3,ik4,ss,ilo1,fac, &
                 1.0,0.5,0.,0.5,0.5,1.0,0.,0.5,1.)
                tw=ww*fac

!       pion0 + cascade0-
            else if(kl == 111 .and. kl1 == -3322)then
                if(isinel(318) == 0)then
                    si1=0D0
                    goto 816
                endif
                ik1=321
                ik2=-3222
                call srev(kl,kl1,ik1,ik2,ss,ilo1,fac, &
                 1.0,0.5,0.,0.5,0.5,1.0,0.,0.5,1.)
                the=PMAS(PYCOMP(321),1)+PMAS(PYCOMP(-3222),1)
                si1=10D0*s1724(ss,ilo1,0,the)*fac
816             if(isinel(323) == 0)then
                    si2=0D0
                    goto 817
                endif
                ik1=311
                ik2=-3212
                call srev(kl,kl1,ik1,ik2,ss,ilo2,fac, &
                 1.0,0.5,0.,0.5,0.5,1.0,0.,0.5,1.)
                the=PMAS(PYCOMP(311),1)+PMAS(PYCOMP(-3212),1)
                si2=10D0*s1724(ss,ilo2,0,the)*fac
817             if(isinel(324) == 0)then
                    si3=0D0
                    goto 818
                endif
                ik1=311
                ik2=-3122
                call srev(kl,kl1,ik1,ik2,ss,ilo3,fac, &
                 1.0,0.5,0.,0.5,0.5,0.0,0.,0.5,1.)
                the=PMAS(PYCOMP(311),1)+PMAS(PYCOMP(-3122),1)
                si3=10D0*s1724(ss,ilo3,0,the)*fac
818             if(isinel(138) == 0)then
                    si4=0D0
                    goto 1818
                endif
                the=PMAS(PYCOMP(-321),1)+PMAS(PYCOMP(-3334),1)
                si4=s1724(ss,ilo4,0,the)
1818            if(ilo1 == 0 .and. ilo2 == 0 .and. ilo3 == 0.and. &
                    ilo4 == 0) return
                if(si1 < 1D-6.and.si2 < 1D-6.and.si3 < 1D-6.and. &
                    si4 < 1D-6) return
                si12=si1+si2
                si13=si12+si3
                si14=si13+si4
                s1=si1/si14
                s2=si12/si14
                s3=si13/si14
                rlu1=PYR(1)
                if(rlu1 <= s1)then
                    ik1=321
                    ik2=-3222
                    ic=318
!       pion0 + cascade0- to k+ + sigma+ba
                    goto 819
                endif
                if(rlu1 > s1 .and. rlu1 <= s2)then
                    ik1=311
                    ik2=-3212
                    ic=323
!       pion0 + cascade0- to k0 + sigma0-
                    goto 819
                endif
                if(rlu1 > s2 .and. rlu1 <= s3)then
                    ik1=311
                    ik2=-3122
                    ic=324
!       pion0 + cascade0- to k0 + lambda-
                    goto 819
                endif
                ik1=-321
                ik2=-3334
                ic=138
!       pion0 + cascade0- to k- + Omega-ba
819             lc(3)=ik1
                lc(4)=ik2
                lc(5)=ic
                tw=si14/cspin/10D0

            else
                write(*,*) "Warning! piCascade_coll-Cacadebar: some channels " &
                        // "are missing. KF1, KF2 =", kl, kl1
                return
            endif

        end if

        ioo = 1


        return
        end



!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
        subroutine piOmega_coll( kl, kl1, ss, lc, tw, ioo )
!!      A part of "prod" to deal with pi + Omega --> ...
!       Finds production and fills up lc(i,3-5), tw(i).
!       pion + Omega channels are defined as 339-346.
!       kl, kl1: the KF code.
!       ss: the total energy (invariant mass) of two hadrons.
!       lc: collision list.
!       tw: the ratio of cross section of (special inela.)/tot.
!       ioo: flag of elastic (0) and inelastic (1) treatment.
        IMPLICIT DOUBLE PRECISION(A-H, O-Z)
        IMPLICIT INTEGER(I-N)
        INTEGER PYCOMP
        COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4)
        common/sa10_h/csnn,cspin,cskn,cspipi,cspsn,cspsm,rcsit,ifram, &
         iabsb,iabsm,i_sigma_AQM,csspn,csspm
        common/sa20_h/t0,cspipiKK,dep,ddt,edipi,epin,ecsnn,ekn,ecspsn,ecspsm, &
         rnt,rnp,ecsspn,ecsspm
        common/iloval/ilo1,ilo2,ilo3,ilo4,ilo5,ilo6,ilo7,ilo8,ilo9
        common/count_h/isinel(2000)
        integer :: lc(6)


        ioo = 0
        ilo = 1

!       pion+ + Omega- to k0- + cascade0
        if(kl == 211 .and. kl1 == 3334)then
            if(isinel(342) == 0) return
            the=PMAS(PYCOMP(-311),1)+PMAS(PYCOMP(3322),1)
            ww=s1724(ss,ilo,0,the)/cspin
            if(ilo == 0) return
            lc(3)=-311
            lc(4)=3322
            lc(5)=342
            ik3=-311
            ik4=3322
            call srev(kl,kl1,ik3,ik4,ss,ilo1,fac, &
             1.0,0.0,0.,1.5,0.5,0.5,0.,0.5,1.)
            tw=ww*fac

!       pion+ + Omega-ba to k+ + cascade-ba
        else if(kl == 211 .and. kl1 == -3334)then
            if(isinel(343) == 0) return
            the=PMAS(PYCOMP(321),1)+PMAS(PYCOMP(-3312),1)
            ww=s1724(ss,ilo,0,the)/cspin
            if(ilo == 0) return
            lc(3)=321
            lc(4)=-3312
            lc(5)=343
            ik3=321
            ik4=-3312
            call srev(kl,kl1,ik3,ik4,ss,ilo1,fac, &
             1.0,0.0,0.,1.5,0.5,0.5,0.,0.5,1.)
            tw=ww*fac

!       pion- + Omega- to k- + cascade-
        else if(kl == -211 .and. kl1 == 3334)then
            if(isinel(339) == 0) return
            the=PMAS(PYCOMP(-321),1)+PMAS(PYCOMP(3312),1)
            ww=s1724(ss,ilo,0,the)/cspin
            if(ilo == 0) return
            lc(3)=-321
            lc(4)=3312
            lc(5)=339
            ik3=-321
            ik4=3312
            call srev(kl,kl1,ik3,ik4,ss,ilo1,fac, &
             1.0,0.0,0.,1.5,0.5,0.5,0.,0.5,1.)
            tw=ww*fac

!       pion- + Omega-ba to k0 + cascade0-
        else if(kl == -211 .and. kl1 == -3334)then
            if(isinel(346) == 0) return
            the=PMAS(PYCOMP(311),1)+PMAS(PYCOMP(-3322),1)
            ww=s1724(ss,ilo,0,the)/cspin
            if(ilo == 0) return
            lc(3)=311
            lc(4)=-3322
            lc(5)=346
            ik3=311
            ik4=-3322
            call srev(kl,kl1,ik3,ik4,ss,ilo1,fac, &
            1.0,0.0,0.,1.5,0.5,0.5,0.,0.5,1.)
            tw=ww*fac

!       pion0 + Omega-
        else if(kl == 111 .and. kl1 == 3334)then
            if(isinel(340) == 0)then
                si1=0D0
                goto 820
            endif
            ik1=-311
            ik2=3312
            call srev(kl,kl1,ik1,ik2,ss,ilo1,fac, &
             1.0,0.0,0.,1.5,0.5,0.5,0.,0.5,1.)
            the=PMAS(PYCOMP(-311),1)+PMAS(PYCOMP(3312),1)
            si1=s1724(ss,ilo1,0,the)*fac
820         if(isinel(341) == 0)then
                si2=0D0
                goto 821
            endif
            ik1=-321
            ik2=3322
            call srev(kl,kl1,ik1,ik2,ss,ilo2,fac, &
             1.0,0.0,0.,1.5,0.5,0.5,0.,0.5,1.)
            the=PMAS(PYCOMP(-321),1)+PMAS(PYCOMP(3322),1)
            si2=s1724(ss,ilo2,0,the)*fac
821         if(ilo1 == 0 .and. ilo2 == 0) return
            if(si1 < 1D-6.and.si2 < 1D-6) return
            si12=si1+si2
            s1=si1/si12
            rlu1=PYR(1)
            if(rlu1 <= s1)then
                ik1=-311
                ik2=3312
                ic=340
!       pion0 + Omega- to k0- + cascade-
                goto 822
            endif
            ik1=-321
            ik2=3322
            ic=341
!       pion0 + Omega- to k- + cascade0
822         lc(3)=ik1
            lc(4)=ik2
            lc(5)=ic
            tw=si12/cspin

!       pion0 + Omega-ba
        else if(kl == 111 .and. kl1 == -3334)then
            if(isinel(344) == 0)then
                si1=0D0
                goto 823
            endif
            ik1=311
            ik2=-3312
            call srev(kl,kl1,ik1,ik2,ss,ilo1,fac, &
             1.0,0.0,0.,1.5,0.5,0.5,0.,0.5,1.)
            the=PMAS(PYCOMP(311),1)+PMAS(PYCOMP(-3312),1)
            si1=s1724(ss,ilo1,0,the)*fac
823         if(isinel(345) == 0)then
                si2=0D0
                goto 824
            endif
            ik1=321
            ik2=-3322
            call srev(kl,kl1,ik1,ik2,ss,ilo2,fac, &
             1.0,0.0,0.,1.5,0.5,0.5,0.,0.5,1.)
            the=PMAS(PYCOMP(321),1)+PMAS(PYCOMP(-3322),1)
            si2=s1724(ss,ilo2,0,the)*fac
824         if(ilo1 == 0 .and. ilo2 == 0) return
            if(si1 < 1D-6.and.si2 < 1D-6) return
            si12=si1+si2
            s1=si1/si12
            rlu1=PYR(1)
            if(rlu1 <= s1)then
                ik1=311
                ik2=-3312
                ic=344
!       pion0 + Omega-ba to k0 + cascade-ba
                goto 825
            endif
            ik1=321
            ik2=-3322
            ic=345
!       pion0 + Omega-ba to k+ + cascade0-
825         lc(3)=ik1
            lc(4)=ik2
            lc(5)=ic
            tw=si12/cspin

        else
            write(*,*) "Warning! piOmega_coll: some channels " &
                    // "are missing. KF1, KF2 =", kl, kl1
            return
        end if

        ioo = 1


        return
        end



!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
        subroutine KK_coll( kl, kl1, ss, lc, tw, ioo )
!!      A part of "prod" to deal with K + K --> ...
!       Finds production and fills up lc(i,3-5), tw(i).
!       Kaon + Kaon channels are defined as 201-206.
!       kl, kl1: the KF code.
!       ss: the total energy (invariant mass) of two hadrons.
!       lc: collision list.
!       tw: the ratio of cross section of (special inela.)/tot.
!       ioo: flag of elastic (0) and inelastic (1) treatment.
        IMPLICIT DOUBLE PRECISION(A-H, O-Z)
        IMPLICIT INTEGER(I-N)
        common/sa10_h/csnn,cspin,cskn,cspipi,cspsn,cspsm,rcsit,ifram, &
         iabsb,iabsm,i_sigma_AQM,csspn,csspm
        common/sa20_h/t0,cspipiKK,dep,ddt,edipi,epin,ecsnn,ekn,ecspsn,ecspsm, &
         rnt,rnp,ecsspn,ecsspm
        common/iloval/ilo1,ilo2,ilo3,ilo4,ilo5,ilo6,ilo7,ilo8,ilo9
        common/count_h/isinel(2000)
        integer :: lc(6)


        ioo   = 0
        fact1 = 0D0
        fact2 = 0D0

!       K+ + K-
        if((kl == 321 .and. kl1 == -321) &
            .or.(kl == -321 .and. kl1 == 321))then
            if(isinel(201) == 0)then
                fact1=0D0
                goto 601
            endif
            ik3=211
            ik4=-211
            ic3=201
            call srev(kl,kl1,ik3,ik4,ss,ilo1,fac, &
            0.5,0.5,0.,0.,1.,1.,0.,0.,1.)
!       K+ + K- to pi+ + pi-
            fact1=fac
            if(ilo1 == 0) fact1=0D0
601         if(isinel(202) == 0)then
                fact2=0D0
                goto 602
            endif
            ik5=111
            ik6=111
            ic5=202
            call srev(kl,kl1,ik5,ik6,ss,ilo2,fac, &
             0.5,0.5,0.,0.,1.,1.,0.,0.,0.5)
!       K+ + K- to pi0 + pi0
            fact2=fac
            if(ilo2 == 0) fact2=0D0
602         fact=fact1+fact2
            if( fact1 <= 1D-5 .AND. fact2 <= 1D-5 ) return
            lc(3)=ik3
            lc(4)=ik4
            lc(5)=ic3
            if(PYR(1) > fact1/fact)then
                lc(3)=ik5
                lc(4)=ik6
                lc(5)=ic5
            endif
            tw=fact*cspipiKK/cspipi

!       K+ + K0-
        else if((kl == 321 .and. kl1 == -311) &
            .or.(kl == -311 .and. kl1 == 321))then
            if(isinel(203) == 0) return
            ik3=211
            ik4=111
            call srev(kl,kl1,ik3,ik4,ss,ilo1,fac, &
            0.5,0.5,0.,0.,1.,1.,0.,0.,1.)
!       K+ + K0- to pi+ + pi0
            if(ilo1 == 0) return
            lc(3)=ik3
            lc(4)=ik4
            lc(5)=203
            tw=fac*cspipiKK/cspipi

!       K- + K0
        else if((kl == -321 .and. kl1 == 311) &
            .or.(kl == 311 .and. kl1 == -321))then
            if(isinel(204) == 0) return
                ik3=-211
                ik4=111
            call srev(kl,kl1,ik3,ik4,ss,ilo1,fac, &
            0.5,0.5,0.,0.,1.,1.,0.,0.,1.)
!       K- + K0 to pi- + pi0
            if(ilo1 == 0) return
            lc(3)=ik3
            lc(4)=ik4
            lc(5)=204
            tw=fac*cspipiKK/cspipi

!       K0 + K0-
        else if((kl == 311 .and. kl1 == -311) &
            .or.(kl == -311 .and. kl1 == 311))then
            if(isinel(205) == 0)then
                fact1=0D0
                goto 603
            endif
            ik3=211
            ik4=-211
            ic3=205
            call srev(kl,kl1,ik3,ik4,ss,ilo1,fac, &
            0.5,0.5,0.,0.,1.,1.,0.,0.,1.)
!       K0 + K0- to pi- + pi+
            fact1=fac
            if(ilo1 == 0) fact1=0D0
603         if(isinel(206) == 0)then
                fact2=0D0
                goto 604
            endif
            ik5=111
            ik6=111
            ic5=206
            call srev(kl,kl1,ik5,ik6,ss,ilo2,fac, &
            0.5,0.5,0.,0.,1.,1.,0.,0.,0.5)
!       K0 + K0- to pi0 + pi0
            fact2=fac
            if(ilo2 == 0) fact2=0D0
604         fact=fact1+fact2
            if( fact1 <= 1D-5 .AND. fact2 <= 1D-5 ) return
            lc(3)=ik3
            lc(4)=ik4
            lc(5)=ic3
            if(PYR(1) > fact1/fact)then
                lc(3)=ik5
                lc(4)=ik6
                lc(5)=ic5
            endif
            tw=fact*cspipiKK/cspipi

        else
            write(*,*) "Warning! KK_coll: some channels are missing. " &
                    // "KF1, KF2 =", kl, kl1
            return
        endif

        ioo   = 1


        return
        end



!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
        subroutine KN_coll( kl, kl1, ss, lc, tw, ioo )
!!      A part of "prod" to deal with K + N --> ...
!       Finds production and fills up lc(i,3-5), tw(i).
!       Kaon + N channels are defined as 49-82, 125-130.
!       kl, kl1: the KF code.
!       ss: the total energy (invariant mass) of two hadrons.
!       lc: collision list.
!       tw: the ratio of cross section of (special inela.)/tot.
!       ioo: flag of elastic (0) and inelastic (1) treatment.
        IMPLICIT DOUBLE PRECISION(A-H, O-Z)
        IMPLICIT INTEGER(I-N)
        INTEGER PYCOMP
        COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4)
        common/sa10_h/csnn,cspin,cskn,cspipi,cspsn,cspsm,rcsit,ifram, &
         iabsb,iabsm,i_sigma_AQM,csspn,csspm
        common/sa20_h/t0,cspipiKK,dep,ddt,edipi,epin,ecsnn,ekn,ecspsn,ecspsm, &
         rnt,rnp,ecsspn,ecsspm
        common/iloval/ilo1,ilo2,ilo3,ilo4,ilo5,ilo6,ilo7,ilo8,ilo9
        common/count_h/isinel(2000)
        integer :: lc(6)


        ioo = 0

!       K + N
        if( kl1 > 0 )then

!       K- + p
            if(kl == -321 .and. kl1 == 2212)then
                if(isinel(49) == 0)then
                    si1=0D0
                    goto 407
                endif
                the=PMAS(PYCOMP(111),1)+PMAS(PYCOMP(3122),1)
                si1=s1724(ss,ilo1,0,the)
!       cross section of k + n to pion + y is assumed equal 
!        ten times of pion + n to k + y
407             if(isinel(50) == 0)then
                    si2=0D0
                    goto 408
                endif
                the=PMAS(PYCOMP(111),1)+PMAS(PYCOMP(3212),1)
                si2=s1724(ss,ilo2,0,the)
408             if(isinel(51) == 0)then
                    si3=0D0
                    goto 411
                endif
                the=PMAS(PYCOMP(-211),1)+PMAS(PYCOMP(3222),1)
                si3=s1724(ss,ilo3,0,the)
411             if(isinel(52) == 0)then
                    si4=0D0
                    goto 431
                endif
                the=PMAS(PYCOMP(211),1)+PMAS(PYCOMP(3112),1)
                si4=s1724(ss,ilo4,0,the)
431             if(isinel(53) == 0)then
                    si5=0D0
                    goto 412
                endif
                the=PMAS(PYCOMP(321),1)+PMAS(PYCOMP(3312),1)
                si5=s1724(ss,ilo5,0,the)/10D0
!       cross section of Kaon + n to Kaon + cascade is assumed to be
!        equal to pion + n to Kaon + y,but take the different of
!        threshold energy into account
412             if(isinel(125) == 0)then
                    si6=0.
                    goto 725
                endif
                the=PMAS(PYCOMP(311),1)+PMAS(PYCOMP(3322),1)
                si6=s1724(ss,ilo6,0,the)/10D0
725             if(ilo1 == 0 .and. ilo2 == 0 .and. ilo3 == 0 .and. ilo4 == 0 &
                    .and. ilo5 == 0 .and. ilo6 == 0) return
                if(si1 < 1D-6.and.si2 < 1D-6.and.si3 < 1D-6 &
                    .and.si4 < 1D-6 .and. si5 <= 1D-6 .and.si6 <= 1D-6) return
                si12=si1+si2
                si13=si12+si3
                si14=si13+si4
                si15=si14+si5
                si16=si15+si6
                s1=si1/si16
                s2=si12/si16
                s3=si13/si16
                s4=si14/si16
                s5=si15/si16
                rlu1=PYR(1)
                if(rlu1 <= s1)then
                    ik1=111
                    ik2=3122
                    ic=49
!       K- + p to pion0 + lambda
                    goto 414
                endif
                if(rlu1 > s1 .and. rlu1 <= s2)then
                    ik1=111
                    ik2=3212
                    ic=50
!       K- + p to pion0 + sigma0
                    goto 414
                endif
                if(rlu1 > s2 .and. rlu1 <= s3)then
                    ik1=-211
                    ik2=3222
                    ic=51
!       K- + p to pion- + sigma+
                    goto 414
                endif
                if(rlu1 > s3 .and. rlu1 <= s4)then
                    ik1=211
                    ik2=3112
                    ic=52
!       K- + p to pion+ + sigma-
                    goto 414
                endif
                if(rlu1 > s4 .and. rlu1 <= s5)then
                    ik1=321
                    ik2=3312
                    ic=53
!       K- + p to k+ + cascade-
                    goto 414
                endif
                ik1=311
                ik2=3322
                ic=125
!       K- + p to k0 + cascade0
414             lc(3)=ik1
                lc(4)=ik2
                lc(5)=ic
                tw=si16/cskn

!       K- + n
            else if(kl == -321 .and. kl1 == 2112)then
                if(isinel(54) == 0)then
                    si1=0D0
                    goto 415
                endif
                the=PMAS(PYCOMP(-211),1)+PMAS(PYCOMP(3212),1)
                si1=s1724(ss,ilo1,0,the)
415             if(isinel(55) == 0)then
                    si2=0D0
                    goto 416
                endif
                the=PMAS(PYCOMP(-211),1)+PMAS(PYCOMP(3122),1)
                si2=s1724(ss,ilo2,0,the)
416             if(isinel(56) == 0)then
                    si3=0D0
                    goto 417
                endif
                the=PMAS(PYCOMP(111),1)+PMAS(PYCOMP(3112),1)
                si3=s1724(ss,ilo3,0,the)
417             if(isinel(57) == 0)then
                    si4=0D0
                    goto 432
                endif
                the=PMAS(PYCOMP(311),1)+PMAS(PYCOMP(3312),1)
                si4=s1724(ss,ilo4,0,the)/10D0
432             if(ilo1 == 0.and.ilo2 == 0.and.ilo3 == 0.and.ilo4 == 0) return
                if(si1 < 1D-6.and.si2 < 1D-6.and.si3 < 1D-6 &
                    .and.si4 < 1D-6) return
                si12=si1+si2
                si13=si12+si3
                si14=si13+si4
                s1=si1/si14
                s2=si12/si14
                s3=si13/si14
                rlus=PYR(1)
                if(rlus <= s1)then
                    ik1=-211
                    ik2=3212
                    ic=54
!       K- + n to pion- + sigma0
                    goto 418
                endif
                if(rlus > s1 .and. rlus <= s2)then
                    ik1=-211
                    ik2=3122
                    ic=55
!       K- + n to pion- + lambda
                    goto 418
                endif
                if(rlus > s2 .and. rlus <= s3)then
                    ik1=111
                    ik2=3112
                    ic=56
!       K- + n to pion0 + sigma-
                    goto 418
                endif
                ik1=311
                ik2=3312
                ic=57
!       K- + n to k0 + cascade-
418             lc(3)=ik1
                lc(4)=ik2
                lc(5)=ic
                tw=si14/cskn

!       k0- + p
            else if(kl == -311 .and. kl1 == 2212)then
                if(isinel(58) == 0)then
                    si1=0D0
                    goto 419
                endif
                the=PMAS(PYCOMP(211),1)+PMAS(PYCOMP(3122),1)
                si1=s1724(ss,ilo1,0,the)
419             if(isinel(59) == 0)then
                    si2=0D0
                    goto 420
                endif
                the=PMAS(PYCOMP(211),1)+PMAS(PYCOMP(3212),1)
                si2=s1724(ss,ilo2,0,the)
420             if(isinel(60) == 0)then
                    si3=0D0
                    goto 421
                endif
                the=PMAS(PYCOMP(111),1)+PMAS(PYCOMP(3222),1)
                si3=s1724(ss,ilo3,0,the)
421             if(isinel(126) == 0)then
                    si4=0D0
                    goto 726
                endif
                the=PMAS(PYCOMP(321),1)+PMAS(PYCOMP(3322),1)
                si4=s1724(ss,ilo4,0,the)/10D0
726             if(ilo1 == 0.and.ilo2 == 0.and.ilo3 == 0.and.ilo4 == 0) return
                if(si1 < 1D-6.and.si2 < 1D-6.and.si3 < 1D-6.and.si4 < &
                    1D-6) return
                si12=si1+si2
                si13=si12+si3
                sit=si13+si4
                s1=si1/sit
                s2=si12/sit
                s3=si13/sit
                rlus=PYR(1)
                if(rlus <= s1)then
                    ik1=211
                    ik2=3122
                    ic=58
!       k0- + p to pion+ + lambda
                    goto 422
                endif
                if(rlus > s1 .and. rlus <= s2)then
                    ik1=211
                    ik2=3212
                    ic=59
!       k0- + p to pion+ + sigma0
                    goto 422
                endif
                if(rlus > s2 .and. rlus <= s3)then
                    ik1=111
                    ik2=3222
                    ic=60
!       k0- + p to pion0 + sigma+
                    goto 422
                endif
                ik1=321
                ik2=3322
                ic=126
!       k0- + p to k+ + cascade0
422             lc(3)=ik1
                lc(4)=ik2
                lc(5)=ic
                tw=sit/cskn

!       k0- + n
            else if(kl == -311 .and. kl1 == 2112)then
                if(isinel(61) == 0)then
                    si1=0D0
                    goto 423
                endif
                the=PMAS(PYCOMP(211),1)+PMAS(PYCOMP(3112),1)
                si1=s1724(ss,ilo1,0,the)
423             if(isinel(62) == 0)then
                    si2=0D0
                    goto 424
                endif
                the=PMAS(PYCOMP(-211),1)+PMAS(PYCOMP(3222),1)
                si2=s1724(ss,ilo2,0,the)
424             if(isinel(63) == 0)then
                    si3=0D0
                    goto 425
                endif
                the=PMAS(PYCOMP(111),1)+PMAS(PYCOMP(3212),1)
                si3=s1724(ss,ilo3,0,the)
425             if(isinel(64) == 0)then
                    si4=0D0
                    goto 426
                endif
                the=PMAS(PYCOMP(111),1)+PMAS(PYCOMP(3122),1)
                si4=s1724(ss,ilo4,0,the)
426             if(isinel(65) == 0)then
                    si5=0D0
                    goto 433
                endif
                the=PMAS(PYCOMP(321),1)+PMAS(PYCOMP(3312),1)
                si5=s1724(ss,ilo5,0,the)/10D0
433             if(isinel(127) == 0)then
                    si6=0D0
                    goto 729
                endif
                the=PMAS(PYCOMP(311),1)+PMAS(PYCOMP(3322),1)
                si6=s1724(ss,ilo6,0,the)/10D0
729             if(ilo1 == 0 .and. ilo2 == 0 .and. ilo3 == 0 .and. ilo4 == 0 &
                    .and. ilo5 == 0 .and. ilo6 == 0) return
                if(si1 < 1D-6.and.si2 < 1D-6.and.si3 < 1D-6 &
                    .and.si4 < 1D-6.and.si5 < 1D-6.and.si6 < 1D-6) return
                si12=si1+si2
                si13=si12+si3
                si14=si13+si4
                si15=si14+si5
                si16=si15+si6
                s1=si1/si16
                s2=si12/si16
                s3=si13/si16
                s4=si14/si16
                s5=si15/si16
                rlu1=PYR(1)
                if(rlu1 <= s1)then
                    ik1=211
                    ik2=3112
                    ic=61
!       k0- + n to pion+ + sigma-
                    goto 427
                endif
                if(rlu1 > s1 .and. rlu1 <= s2)then
                    ik1=-211
                    ik2=3222
                    ic=62
!       k0- + n to pion- + sigma+
                    goto 427
                endif
                if(rlu1 > s2 .and. rlu1 <= s3)then
                    ik1=111
                    ik2=3212
                    ic=63
!       k0- + n to pion0 + sigma0
                    goto 427
                endif
                if(rlu1 > s3 .and. rlu1 <= s4)then
                    ik1=111
                    ik2=3122
                    ic=64
!       k0- + n to pion0 + lambda
                    goto 427
                endif
                if(rlu1 > s4 .and. rlu1 <= s5)then
                    ik1=321
                    ik2=3312
                    ic=65
!       k0- + n to k+ + cascade-
                    goto 427
                endif
                ik1=311
                ik2=3322
                ic=127
!       k0- + n to k0 + cascade0
427             lc(3)=ik1
                lc(4)=ik2
                lc(5)=ic
                tw=si16/cskn

            else
                write(*,*) "Warning! KN_coll-N: some channels are missing. " &
                        // "KF1, KF2 =", kl, kl1
                return
            end if

!       K + Nbar
        else

!       K+ + p-
            if(kl == 321 .and. kl1 == -2212)then
                if(isinel(66) == 0)then
                    si1=0D0
                    goto 510
                endif
                the=PMAS(PYCOMP(111),1)+PMAS(PYCOMP(-3122),1)
                si1=s1724(ss,ilo1,0,the)
!       cross section of k + n- to pion + y- is assumed equal 
!        ten times of pion + n to k + y
510             if(isinel(67) == 0)then
                    si2=0D0
                    goto 511
                endif
                the=PMAS(PYCOMP(111),1)+PMAS(PYCOMP(-3212),1)
                si2=s1724(ss,ilo2,0,the)
511             if(isinel(68) == 0)then
                    si3=0D0
                    goto 512
                endif
                the=PMAS(PYCOMP(211),1)+PMAS(PYCOMP(-3222),1)
                si3=s1724(ss,ilo3,0,the)
512             if(isinel(69) == 0)then
                    si4=0D0
                    goto 513
                endif
                the=PMAS(PYCOMP(-211),1)+PMAS(PYCOMP(-3112),1)
                si4=s1724(ss,ilo4,0,the)
513             if(isinel(70) == 0)then
                    si5=0D0
                    goto 514
                endif
                the=PMAS(PYCOMP(-321),1)+PMAS(PYCOMP(-3312),1)
                si5=s1724(ss,ilo5,0,the)/10D0
514             if(isinel(128) == 0)then
                    si6=0D0
                    goto 730
                endif
                the=PMAS(PYCOMP(-311),1)+PMAS(PYCOMP(-3322),1)
                si6=s1724(ss,ilo6,0,the)/10D0
730             if(ilo1 == 0 .and. ilo2 == 0 .and. ilo3 == 0 .and. ilo4 == 0 &
                    .and. ilo5 == 0 .and. ilo6 == 0) return
                if(si1 < 1D-6.and.si2 < 1D-6.and.si3 < 1D-6 &
                    .and.si4 < 1D-6 .and. si5 < 1D-6.and.si6 < 1D-6) return
                si12=si1+si2
                si13=si12+si3
                si14=si13+si4
                si15=si14+si5
                si16=si15+si6
                s1=si1/si16
                s2=si12/si16
                s3=si13/si16
                s4=si14/si16
                s5=si15/si16
                rlu1=PYR(1)
                if(rlu1 <= s1)then
                    ik1=111
                    ik2=-3122
                    ic=66
!       K+ + p- to pion0 + lambda-
                    goto 515
                endif
                if(rlu1 > s1 .and. rlu1 <= s2)then
                    ik1=111
                    ik2=-3212
                    ic=67
!       K+ + p- to pion0 + sigma0-
                    goto 515
                endif
                if(rlu1 > s2 .and. rlu1 <= s3)then
                    ik1=211
                    ik2=-3222
                    ic=68
!       K+ + p- to pion+ + sigma+ba
                    goto 515
                endif
                if(rlu1 > s3 .and. rlu1 <= s4)then
                    ik1=-211
                    ik2=-3112
                    ic=69
!       K+ + p- to pion- + sigma-ba
                    goto 515
                endif
                if(rlu1 > s4 .and. rlu1 <= s5)then
                    ik1=-321
                    ik2=-3312
                    ic=70
!       K+ + p- to k- + cascade-ba
                    goto 515
                endif
                ik1=-311
                ik2=-3322
                ic=128
!       K+ + p- to k0- + cascade0ba
515             lc(3)=ik1
                lc(4)=ik2
                lc(5)=ic
                tw=si16/cskn

!       K+ + n-
            else if(kl == 321 .and. kl1 == -2112)then
                if(isinel(71) == 0)then
                    si1=0D0
                    goto 516
                endif
                the=PMAS(PYCOMP(211),1)+PMAS(PYCOMP(-3212),1)
                si1=s1724(ss,ilo1,0,the)
516             if(isinel(72) == 0)then
                    si2=0D0
                    goto 517
                endif
                the=PMAS(PYCOMP(211),1)+PMAS(PYCOMP(-3122),1)
                si2=s1724(ss,ilo2,0,the)
517             if(isinel(73) == 0)then
                    si3=0D0
                    goto 518
                endif
                the=PMAS(PYCOMP(111),1)+PMAS(PYCOMP(-3112),1)
                si3=s1724(ss,ilo3,0,the)
518             if(isinel(74) == 0)then
                si4=0D0
                goto 519
                endif
                the=PMAS(PYCOMP(-311),1)+PMAS(PYCOMP(-3312),1)
                si4=s1724(ss,ilo4,0,the)/10D0
519             if(ilo1 == 0.and.ilo2 == 0.and.ilo3 == 0.and.ilo4 == 0) return
                if(si1 < 1D-6.and.si2 < 1D-6.and.si3 < 1D-6 &
                    .and.si4 < 1D-6) return
                si12=si1+si2
                si13=si12+si3
                si14=si13+si4
                s1=si1/si14
                s2=si12/si14
                s3=si13/si14
                rlus=PYR(1)
                if(rlus <= s1)then
                    ik1=211
                    ik2=-3212
                    ic=71
!       K+ + n- to pion+ + sigma0-
                    goto 520
                endif
                if(rlus > s1 .and. rlus <= s2)then
                    ik1=211
                    ik2=-3122
                    ic=72
!       K+ + n- to pion+ + lambda-
                    goto 520
                endif
                if(rlus > s2 .and. rlus <= s3)then
                    ik1=111
                    ik2=-3112
                    ic=73
!       K+ + n- to pion0 + sigma-ba
                    goto 520
                endif
                ik1=-311
                ik2=-3312
                ic=74
!       K+ + n- to k0- + cascade-ba
520             lc(3)=ik1
                lc(4)=ik2
                lc(5)=ic
                tw=si14/cskn

!       k0 + p-
            else if(kl == 311 .and. kl1 == -2212)then
                if(isinel(75) == 0)then
                    si1=0D0
                    goto 521
                endif
                the=PMAS(PYCOMP(-211),1)+PMAS(PYCOMP(-3122),1)
                si1=s1724(ss,ilo1,0,the)
521             if(isinel(76) == 0)then
                    si2=0D0
                    goto 522
                endif
                the=PMAS(PYCOMP(-211),1)+PMAS(PYCOMP(-3212),1)
                si2=s1724(ss,ilo2,0,the)
522             if(isinel(77) == 0)then
                    si3=0D0
                    goto 523
                endif
                the=PMAS(PYCOMP(111),1)+PMAS(PYCOMP(-3222),1)
                si3=s1724(ss,ilo3,0,the)
523             if(isinel(129) == 0)then
                    si4=0D0
                    goto 731
                endif
                the=PMAS(PYCOMP(-321),1)+PMAS(PYCOMP(-3322),1)
                si4=s1724(ss,ilo4,0,the)/10D0
731             if(ilo1 == 0.and.ilo2 == 0.and.ilo3 == 0.and.ilo4 == 0) return
                if(si1 < 1D-6.and.si2 < 1D-6.and.si3 < 1D-6.and. &
                    si4 < 1D-6) return
                si12=si1+si2
                si13=si12+si3
                sit=si13+si4
                s1=si1/sit
                s2=si12/sit
                s3=si13/sit
                rlus=PYR(1)
                if(rlus <= s1)then
                    ik1=-211
                    ik2=-3122
                    ic=75
!       k0 + p- to pion- + lambda-
                    goto 524
                endif
                if(rlus > s1 .and. rlus <= s2)then
                    ik1=-211
                    ik2=-3212
                    ic=76
!   k0 + p- to pion- + sigma0-
                    goto 524
                endif
                if(rlus > s2 .and. rlus <= s3)then
                    ik1=111
                    ik2=-3222
                    ic=77
!   k0 + p- to pion0 + sigma+ba
                    goto 524
                endif
                ik1=-321
                ik2=-3322
                ic=129
!   k0 + p- to k- + cascade0-
524             lc(3)=ik1
                lc(4)=ik2
                lc(5)=ic
                tw=sit/cskn

!       k0 + n-
            else if(kl == 311 .and. kl1 == -2112)then
                if(isinel(78) == 0)then
                    si1=0D0
                    goto 525
                endif
                the=PMAS(PYCOMP(-211),1)+PMAS(PYCOMP(-3112),1)
                si1=s1724(ss,ilo1,0,the)
525             if(isinel(79) == 0)then
                    si2=0D0
                    goto 526
                endif
                the=PMAS(PYCOMP(211),1)+PMAS(PYCOMP(-3222),1)
                si2=s1724(ss,ilo2,0,the)
526             if(isinel(80) == 0)then
                    si3=0D0
                    goto 527
                endif
                the=PMAS(PYCOMP(111),1)+PMAS(PYCOMP(-3212),1)
                si3=s1724(ss,ilo3,0,the)
527             if(isinel(81) == 0)then
                    si4=0D0
                    goto 528
                endif
                the=PMAS(PYCOMP(111),1)+PMAS(PYCOMP(-3122),1)
                si4=s1724(ss,ilo4,0,the)
528             if(isinel(82) == 0)then
                    si5=0D0
                    goto 5299
                endif
                the=PMAS(PYCOMP(-321),1)+PMAS(PYCOMP(-3312),1)
                si5=s1724(ss,ilo5,0,the)/10D0
5299            if(isinel(130) == 0)then
                    si6=0D0
                    goto 529
                endif
                the=PMAS(PYCOMP(-311),1)+PMAS(PYCOMP(-3322),1)
                si6=s1724(ss,ilo6,0,the)/10D0
529             if(ilo1 == 0 .and. ilo2 == 0 .and. ilo3 == 0 .and. ilo4 == 0 &
                    .and. ilo5 == 0.and. ilo6 == 0) return
                if(si1 < 1D-6.and.si2 < 1D-6.and.si3 < 1D-6 &
                    .and.si4 < 1D-6.and.si5 < 1D-6.and.si6 < 1D-6) return
                si12=si1+si2
                si13=si12+si3
                si14=si13+si4
                si15=si14+si5
                si16=si15+si6
                s1=si1/si16
                s2=si12/si16
                s3=si13/si16
                s4=si14/si16
                s5=si15/si16
                rlu1=PYR(1)
                if(rlu1 <= s1)then
                    ik1=-211
                    ik2=-3112
                    ic=78
!       k0 + n- to pion- + sigma-ba
                    goto 530
                endif
                if(rlu1 > s1 .and. rlu1 <= s2)then
                    ik1=211
                    ik2=-3222
                    ic=79
!       k0 + n- to pion+ + sigma+ba
                    goto 530
                endif
                if(rlu1 > s2 .and. rlu1 <= s3)then
                    ik1=111
                    ik2=-3212
                    ic=80
!       k0 + n- to pion0 + sigma0-
                    goto 530
                endif
                if(rlu1 > s3 .and. rlu1 <= s4)then
                    ik1=111
                    ik2=-3122
                    ic=81
!       k0 + n- to pion0 + lambda-
                    goto 530
                endif
                if(rlu1 > s4 .and. rlu1 <= s5)then
                    ik1=-321
                    ik2=-3312
                    ic=82
!       k0 + n- to k- + cascade-ba
                    goto 530
                endif
                ik1=-311
                ik2=-3322
                ic=130
!       k0 + n- to k0- + cascade0-
530             lc(3)=ik1
                lc(4)=ik2
                lc(5)=ic
                tw=si16/cskn

            else
                write(*,*) "Warning! KN_coll-Nbar: some channels " &
                        // "are missing. KF1, KF2 =", kl, kl1
                return
            endif

        end if

        ioo = 1


        return
        end



!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
        subroutine KY_coll( kl, kl1, ss, lc, tw, ioo )
!!      A part of "prod" to deal with K + Y --> ...
!       Finds production and fills up lc(i,3-5), tw(i).
!       Kaon + Lambda/Sigma channels are defined as 83-96, 111-124, 207-234.
!       kl, kl1: the KF code.
!       ss: the total energy (invariant mass) of two hadrons.
!       lc: collision list.
!       tw: the ratio of cross section of (special inela.)/tot.
!       ioo: flag of elastic (0) and inelastic (1) treatment.
        IMPLICIT DOUBLE PRECISION(A-H, O-Z)
        IMPLICIT INTEGER(I-N)
        INTEGER PYCOMP
        COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4)
        common/sa10_h/csnn,cspin,cskn,cspipi,cspsn,cspsm,rcsit,ifram, &
         iabsb,iabsm,i_sigma_AQM,csspn,csspm
        common/sa20_h/t0,cspipiKK,dep,ddt,edipi,epin,ecsnn,ekn,ecspsn,ecspsm, &
         rnt,rnp,ecsspn,ecsspm
        common/iloval/ilo1,ilo2,ilo3,ilo4,ilo5,ilo6,ilo7,ilo8,ilo9
        common/count_h/isinel(2000)
        integer :: lc(6)


        ioo = 0
        ilo = 1

!       K + Lambda
        if( ABS(kl1) == 3122 )then

!       K- + lambda
            if(kl == -321 .and. kl1 == 3122)then
                if(isinel(83) == 0)then
                    si1=0D0
                    goto 732
                endif
                the=PMAS(PYCOMP(111),1)+PMAS(PYCOMP(3312),1)
                si1=s1724(ss,ilo1,0,the)
!       cross section of k + y to pion + cascade is assumed equal 
!        k + n to pion + y
732             if(isinel(113) == 0)then
                    si2=0D0
                    goto 733
                endif
                the=PMAS(PYCOMP(-211),1)+PMAS(PYCOMP(3322),1)
                si2=s1724(ss,ilo2,0,the)
733             if(ilo1 == 0.and.ilo2 == 0) return
                if(si1 < 1D-6.and.si2 < 1D-6) return
                sit=si1+si2
                s1=si1/sit
                rlus=PYR(1)
                if(rlus <= s1)then
                    ik1=111
                    ik2=3312
                    ic=83
!       K- + lambda to pion0 + cascade-
                    goto 734
                endif
                ik1=-211
                ik2=3322
                ic=113
!       K- + lambda to pion- + cascade0
734             lc(3)=ik1
                lc(4)=ik2
                lc(5)=ic
                tw=sit/cskn

!       k0- + lambda
            else if(kl == -311 .and. kl1 == 3122)then
                if(isinel(87) == 0)then
                    si1=0D0
                    goto 741
                endif
                the=PMAS(PYCOMP(211),1)+PMAS(PYCOMP(3312),1)
                si1=s1724(ss,ilo1,0,the)
741             if(isinel(117) == 0)then
                    si2=0D0
                    goto 742
                endif
                the=PMAS(PYCOMP(111),1)+PMAS(PYCOMP(3322),1)
                si2=s1724(ss,ilo2,0,the)
742             if(ilo1 == 0.and.ilo2 == 0) return
                if(si1 < 1D-6.and.si2 < 1D-6) return
                sit=si1+si2
                s1=si1/sit
                rlus=PYR(1)
                if(rlus <= s1)then
                    ik1=211
                    ik2=3312
                    ic=87
!       k0- + lambda to pion+ + cascade-
                    goto 743
                endif
                ik1=111
                ik2=3322
                ic=117
!       k0- + lambda to pion0 + cascade0
743             lc(3)=ik1
                lc(4)=ik2
                lc(5)=ic
                tw=sit/cskn

!       K+ + lambda-
            else if(kl == 321 .and. kl1 == -3122)then
                if(isinel(90) == 0)then
                    si1=0D0
                    goto 750
                endif
                the=PMAS(PYCOMP(111),1)+PMAS(PYCOMP(-3312),1)
                si1=s1724(ss,ilo1,0,the)
750             if(isinel(120) == 0)then
                    si2=0D0
                    goto 751
                endif
                the=PMAS(PYCOMP(211),1)+PMAS(PYCOMP(-3322),1)
                si2=s1724(ss,ilo2,0,the)
751             if(ilo1 == 0.and.ilo2 == 0) return
                if(si1 < 1D-6.and.si2 < 1D-6) return
                sit=si1+si2
                s1=si1/sit
                rlus=PYR(1)
                if(rlus <= s1)then
                    ik1=111
                    ik2=-3312
                    ic=90
!       K+ + lambda- to pion0 + cascade-ba
                    goto 752
                endif
                ik1=211
                ik2=-3322
                ic=120
!       K+ + lambda- to pion+ + cascade0-
752             lc(3)=ik1
                lc(4)=ik2
                lc(5)=ic
                tw=sit/cskn

!       k0+ + lambda-
            else if(kl == 311 .and. kl1 == -3122)then
                if(isinel(94) == 0)then
                    si1=0D0
                    goto 759
                endif
                the=PMAS(PYCOMP(-211),1)+PMAS(PYCOMP(-3312),1)
                si1=s1724(ss,ilo1,0,the)
759             if(isinel(124) == 0)then
                    si2=0D0
                    goto 760
                endif
                the=PMAS(PYCOMP(111),1)+PMAS(PYCOMP(-3322),1)
                si2=s1724(ss,ilo2,0,the)
760             if(ilo1 == 0.and.ilo2 == 0) return
                if(si1 < 1D-6.and.si2 < 1D-6) return
                sit=si1+si2
                s1=si1/sit
                rlus=PYR(1)
                if(rlus <= s1)then
                    ik1=-211
                    ik2=-3312
                    ic=94
!       k0 + lambda- to pion- + cascade-ba
                    goto 761
                endif
                ik1=111
                ik2=-3322
                ic=124
!       k0 + lambda- to pion0 + cascade0ba
761             lc(3)=ik1
                lc(4)=ik2
                lc(5)=ic
                tw=sit/cskn

!       k0 + lambda0
            else if(kl == 311 .and. kl1 == 3122)then
                if(isinel(219) == 0)then
                    si1=0D0
                    goto 622
                endif
                ik1=-211
                ik2=2212
                call srev(kl,kl1,ik1,ik2,ss,ilo1,fac, &
                 0.5,0.,0.,0.5,1.,0.5,0.,0.5,1.)
                the=PMAS(PYCOMP(-211),1)+PMAS(PYCOMP(2212),1)
                si1=s07122(ss,ilo1,0,the)*fac
622             if(isinel(220) == 0)then
                    si2=0D0
                    goto 623
                endif
                ik1=111
                ik2=2112
                call srev(kl,kl1,ik1,ik2,ss,ilo2,fac, &
                 0.5,0.,0.,0.5,1.,0.5,0.,0.5,1.)
                the=PMAS(PYCOMP(111),1)+PMAS(PYCOMP(2112),1)
                si2=s2317(ss,ilo2,0,the)*fac
623             if(ilo1 == 0.and.ilo2 == 0) return
                if(si1 < 1D-6.and.si2 < 1D-6) return
                sit=si1+si2
                s1=si1/sit
                rlus=PYR(1)
                if(rlus <= s1)then
                    ik1=-211
                    ik2=2212
                    ic=219
!       k0 + lambda0 to pion- + p
                    goto 624
                endif
                ik1=111
                ik2=2112
                ic=220
!       k0 + lambda0 to pion0 + n
624             lc(3)=ik1
                lc(4)=ik2
                lc(5)=ic
                tw=sit/cskn/10D0

!       K+ + lambda0
            else if(kl == 321 .and. kl1 == 3122)then
                if(isinel(212) == 0)then
                    si1=0D0
                    goto 613
                endif
                ik1=211
                ik2=2112
                call srev(kl,kl1,ik1,ik2,ss,ilo1,fac, &
                 0.5,0.,0.,0.5,1.,0.5,0.,0.5,1.)
                the=PMAS(PYCOMP(211),1)+PMAS(PYCOMP(2112),1)
                si1=s1727(ss,ilo1,0,the)*fac
613             if(isinel(213) == 0)then
                    si2=0D0
                    goto 614
                endif
                ik1=111
                ik2=2212
                call srev(kl,kl1,ik1,ik2,ss,ilo2,fac, &
                 0.5,0.,0.,0.5,1.,0.5,0.,0.5,1.)
                the=PMAS(PYCOMP(111),1)+PMAS(PYCOMP(2212),1)
                si2=s2317(ss,ilo2,0,the)*fac
614             if(ilo1 == 0.and.ilo2 == 0) return
                if(si1 < 1D-6.and.si2 < 1D-6) return
                sit=si1+si2
                s1=si1/sit
                rlus=PYR(1)
                if(rlus <= s1)then
                    ik1=211
                    ik2=2112
                    ic=212
!       K+ + lambda0 to pion+ + n
                    goto 615
                endif
                ik1=111
                ik2=2212
                ic=213
!       K+ + lambda0 to pion0 + p
615             lc(3)=ik1
                lc(4)=ik2
                lc(5)=ic
                tw=sit/cskn/10D0

!       K- + lambda0-
            else if(kl == -321 .and. kl1 == -3122)then
                if(isinel(226) == 0)then
                    si1=0D0
                    goto 631
                endif
                ik1=-211
                ik2=-2112
                call srev(kl,kl1,ik1,ik2,ss,ilo1,fac, &
                 0.5,0.,0.,0.5,1.,0.5,0.,0.5,1.)
                the=PMAS(PYCOMP(-211),1)+PMAS(PYCOMP(-2112),1)
                si1=s1724(ss,ilo1,0,the)*fac
631             if(isinel(227) == 0)then
                    si2=0D0
                    goto 632
                endif
                ik1=111
                ik2=-2212
                call srev(kl,kl1,ik1,ik2,ss,ilo2,fac, &
                 0.5,0.,0.,0.5,1.,0.5,0.,0.5,1.)
                the=PMAS(PYCOMP(111),1)+PMAS(PYCOMP(-2212),1)
                si2=s1724(ss,ilo2,0,the)*fac
632             if(ilo1 == 0.and.ilo2 == 0) return
                if(si1 < 1D-6.and.si2 < 1D-6) return
                sit=si1+si2
                s1=si1/sit
                rlus=PYR(1)
                if(rlus <= s1)then
                    ik1=-211
                    ik2=-2112
                    ic=226
!       K- + lambda0ba to pion- + nba
                    goto 633
                endif
                ik1=111
                ik2=-2212
                ic=227
!       K- + lambda0ba to pion0 + pba
633             lc(3)=ik1
                lc(4)=ik2
                lc(5)=ic
                tw=sit/cskn/10D0

!       k0- + lambda0-
            else if(kl == -311 .and. kl1 == -3122)then
                if(isinel(233) == 0)then
                    si1=0D0
                    goto 640
                endif
                ik1=211
                ik2=-2212
                call srev(kl,kl1,ik1,ik2,ss,ilo1,fac, &
                 0.5,0.,0.,0.5,1.,0.5,0.,0.5,1.)
                the=PMAS(PYCOMP(211),1)+PMAS(PYCOMP(-2212),1)
                si1=s1724(ss,ilo1,0,the)*fac
640             if(isinel(234) == 0)then
                    si2=0D0
                    goto 641
                endif
                ik1=111
                ik2=-2112
                call srev(kl,kl1,ik1,ik2,ss,ilo2,fac, &
                 0.5,0.,0.,0.5,1.,0.5,0.,0.5,1.)
                the=PMAS(PYCOMP(111),1)+PMAS(PYCOMP(-2112),1)
                si2=s1724(ss,ilo2,0,the)*fac
641             if(ilo1 == 0.and.ilo2 == 0) return
                if(si1 < 1D-6.and.si2 < 1D-6) return
                sit=si1+si2
                s1=si1/sit
                rlus=PYR(1)
                if(rlus <= s1)then
                    ik1=211
                    ik2=-2212
                    ic=233
!       k0- + lambda0- to pion+ + pba
                    goto 642
                endif
                ik1=111
                ik2=-2112
                ic=234
!       k0- + lambda0- to pion0 + nba
642             lc(3)=ik1
                lc(4)=ik2
                lc(5)=ic
                tw=sit/cskn/10D0

            else
                write(*,*) "Warning! KY_coll-Lambda: some channels " &
                        // "are missing. KF1, KF2 =", kl, kl1
                return
            endif

!       K + Sigma
        else

!       K- + sigma+
            if(kl == -321 .and. kl1 == 3222)then
                if(isinel(84) == 0)then
                    si1=0D0
                    goto 735
                endif
                the=PMAS(PYCOMP(211),1)+PMAS(PYCOMP(3312),1)
                si1=s1724(ss,ilo1,0,the)
735             if(isinel(111) == 0)then
                    si2=0D0
                    goto 736
                endif
                the=PMAS(PYCOMP(111),1)+PMAS(PYCOMP(3322),1)
                si2=s1724(ss,ilo2,0,the)
736             if(ilo1 == 0.and.ilo2 == 0) return
                if(si1 < 1D-6.and.si2 < 1D-6) return
                sit=si1+si2
                s1=si1/sit
                rlus=PYR(1)
                if(rlus <= s1)then
                    ik1=211
                    ik2=3312
                    ic=84
!       K- + sigma+ to pion+ + cascade-
                    goto 737
                endif
                ik1=111
                ik2=3322
                ic=111
!       K- + sigma+ to pion0 + cascade0
737             lc(3)=ik1
                lc(4)=ik2
                lc(5)=ic
                tw=sit/cskn

!       K- + sigma- to pion- + cascade-
            else if(kl == -321 .and. kl1 == 3112)then
                if(isinel(85) == 0) return
                the=PMAS(PYCOMP(-211),1)+PMAS(PYCOMP(3312),1)
                tw=s1724(ss,ilo,0,the)/cskn
                if(ilo == 0) return
                lc(3)=-211
                lc(4)=3312
                lc(5)=85

!       K- + sigma0
            else if(kl == -321 .and. kl1 == 3212)then
                if(isinel(86) == 0)then
                    si1=0D0
                    goto 738
                endif
                the=PMAS(PYCOMP(111),1)+PMAS(PYCOMP(3312),1)
                si1=s1724(ss,ilo1,0,the)
738             if(isinel(112) == 0)then
                    si2=0D0
                    goto 739
                endif
                the=PMAS(PYCOMP(-211),1)+PMAS(PYCOMP(3322),1)
                si2=s1724(ss,ilo2,0,the)
739             if(ilo1 == 0.and.ilo2 == 0) return
                if(si1 < 1D-6.and.si2 < 1D-6) return
                sit=si1+si2
                s1=si1/sit
                rlus=PYR(1)
                if(rlus <= s1)then
                    ik1=111
                    ik2=3312
                    ic=86
!       K- + sigma0 to pion0 + cascade-
                    goto 740
                endif
                ik1=-211
                ik2=3322
                ic=112
740             lc(3)=ik1
                lc(4)=ik2
                lc(5)=ic
                tw=sit/cskn

!       k0- + sigma0
            else if(kl == -311 .and. kl1 == 3212)then
                if(isinel(88) == 0)then
                    si1=0D0
                    goto 744
                endif
                the=PMAS(PYCOMP(211),1)+PMAS(PYCOMP(3312),1)
                si1=s1724(ss,ilo1,0,the)
744             if(isinel(116) == 0)then
                    si2=0D0
                    goto 745
                endif
                the=PMAS(PYCOMP(111),1)+PMAS(PYCOMP(3322),1)
                si2=s1724(ss,ilo2,0,the)
745             if(ilo1 == 0.and.ilo2 == 0) return
                if(si1 < 1D-6.and.si2 < 1D-6) return
                sit=si1+si2
                s1=si1/sit
                rlus=PYR(1)
                if(rlus <= s1)then
                    ik1=211
                    ik2=3312
                    ic=88
!       k0- + sigma0 to pion+ + cascade-
                    goto 746
                endif
                ik1=111
                ik2=3322
                ic=116
!       k0- + sigma0 to pion0 + cascade0
746             lc(3)=ik1
                lc(4)=ik2
                lc(5)=ic
                tw=sit/cskn

!       k0- + sigma-
            else if(kl == -311 .and. kl1 == 3112)then
                if(isinel(89) == 0)then
                    si1=0.
                    goto 747
                endif
                the=PMAS(PYCOMP(111),1)+PMAS(PYCOMP(3312),1)
                si1=s1724(ss,ilo1,0,the)
747             if(isinel(115) == 0)then
                    si2=0D0
                    goto 748
                endif
                the=PMAS(PYCOMP(-211),1)+PMAS(PYCOMP(3322),1)
                si2=s1724(ss,ilo2,0,the)
748             if(ilo1 == 0.and.ilo2 == 0) return
                if(si1 < 1D-6.and.si2 < 1D-6) return
                sit=si1+si2
                s1=si1/sit
                rlus=PYR(1)
                if(rlus <= s1)then
                    ik1=111
                    ik2=3312
                    ic=89
!       k0- + sigma- to pion0 + cascade-
                    goto 749
                endif
                ik1=-211
                ik2=3322
                ic=115
!       k0- + sigma- to pion- + cascade0
749             lc(3)=ik1
                lc(4)=ik2
                lc(5)=ic
                tw=sit/cskn

!       K+ + sigma+ba
            else if(kl == 321 .and. kl1 == -3222)then
                if(isinel(91) == 0)then
                    si1=0D0
                    goto 753
                endif
                the=PMAS(PYCOMP(-211),1)+PMAS(PYCOMP(-3312),1)
                si1=s1724(ss,ilo1,0,the)
753             if(isinel(118) == 0)then
                    si2=0D0
                    goto 754
                endif
                the=PMAS(PYCOMP(111),1)+PMAS(PYCOMP(-3322),1)
                si2=s1724(ss,ilo2,0,the)
754             if(ilo1 == 0.and.ilo2 == 0) return
                if(si1 < 1D-6.and.si2 < 1D-6) return
                sit=si1+si2
                s1=si1/sit
                rlus=PYR(1)
                if(rlus <= s1)then
                    ik1=-211
                    ik2=-3312
                    ic=91
!       K+ + sigma+ba to pion- + cascade-ba
                    goto 755
                endif
                ik1=111
                ik2=-3322
                ic=118
!       K+ + sigma+ba to pion0 + cascade0-
755             lc(3)=ik1
                lc(4)=ik2
                lc(5)=ic
                tw=sit/cskn

!       K+ + sigma-ba to pion+ + cascade-ba
            else if(kl == 321 .and. kl1 == -3112)then
                if(isinel(92) == 0) return
                the=PMAS(PYCOMP(211),1)+PMAS(PYCOMP(-3312),1)
                tw=s1724(ss,ilo,0,the)/cskn
                if(ilo == 0) return
                lc(3)=211
                lc(4)=-3312
                lc(5)=92

!       K+ + sigma0ba
            else if(kl == 321 .and. kl1 == -3212)then
                if(isinel(93) == 0)then
                    si1=0D0
                    goto 756
                endif
                the=PMAS(PYCOMP(111),1)+PMAS(PYCOMP(-3312),1)
                si1=s1724(ss,ilo1,0,the)
756             if(isinel(119) == 0)then
                    si2=0D0
                    goto 757
                endif
                the=PMAS(PYCOMP(211),1)+PMAS(PYCOMP(-3322),1)
                si2=s1724(ss,ilo2,0,the)
757             if(ilo1 == 0.and.ilo2 == 0) return
                if(si1 < 1D-6.and.si2 < 1D-6) return
                sit=si1+si2
                s1=si1/sit
                rlus=PYR(1)
                if(rlus <= s1)then
                    ik1=111
                    ik2=-3312
                    ic=93
!       K+ + sigma0- to pion0 + cascade-ba
                    goto 758
                endif
                ik1=211
                ik2=-3322
                ic=119
!       K+ + sigma0- to pion+ + cascade0-
758             lc(3)=ik1
                lc(4)=ik2
                lc(5)=ic
                tw=sit/cskn

!       k0 + sigma0-
            else if(kl == 311 .and. kl1 == -3212)then
                if(isinel(95) == 0)then
                    si1=0D0
                    goto 762
                endif
                the=PMAS(PYCOMP(-211),1)+PMAS(PYCOMP(-3312),1)
                si1=s1724(ss,ilo1,0,the)
762             if(isinel(123) == 0)then
                    si2=0D0
                    goto 763
                endif
                the=PMAS(PYCOMP(111),1)+PMAS(PYCOMP(-3322),1)
                si2=s1724(ss,ilo2,0,the)
763             if(ilo1 == 0.and.ilo2 == 0) return
                if(si1 < 1D-6.and.si2 < 1D-6) return
                sit=si1+si2
                s1=si1/sit
                rlus=PYR(1)
                if(rlus <= s1)then
                    ik1=-211
                    ik2=-3312
                    ic=95
!       k0 + sigma0- to pion- + cascade-ba
                    goto 764
                endif
                ik1=111
                ik2=-3322
                ic=123
!       k0 + sigma0- to pion0 + cascade0-
764             lc(3)=ik1
                lc(4)=ik2
                lc(5)=ic
                tw=sit/cskn

!       k0 + sigma-ba
            else if(kl == 311 .and. kl1 == -3112)then
                if(isinel(96) == 0)then
                    si1=0D0
                    goto 765
                endif
                the=PMAS(PYCOMP(111),1)+PMAS(PYCOMP(-3312),1)
                si1=s1724(ss,ilo1,0,the)
765             if(isinel(122) == 0)then
                    si2=0D0
                    goto 766
                endif
                the=PMAS(PYCOMP(211),1)+PMAS(PYCOMP(-3322),1)
                si2=s1724(ss,ilo2,0,the)
766             if(ilo1 == 0.and.ilo2 == 0) return
                if(si1 < 1D-6.and.si2 < 1D-6) return
                sit=si1+si2
                s1=si1/sit
                rlus=PYR(1)
                if(rlus <= s1)then
                    ik1=111
                    ik2=-3312
                    ic=96
!       k0 + sigma-ba to pion0 + cascade-ba
                    goto 767
                endif
                ik1=211
                ik2=-3322
                ic=122
!       k0 + sigma-ba to pion+ + cascade0ba
767             lc(3)=ik1
                lc(4)=ik2
                lc(5)=ic
                tw=sit/cskn

!       k0- + sigma+ to pion+ + cascade0
            else if(kl == -311 .and. kl1 == 3222)then
                if(isinel(114) == 0) return
                the=PMAS(PYCOMP(211),1)+PMAS(PYCOMP(3322),1)
                tw=s1724(ss,ilo,0,the)/cskn
                if(ilo == 0) return
                lc(3)=211
                lc(4)=3322
                lc(5)=114

!       k0 + sigma+bar to pion- + cascade0ba
            else if(kl == 311 .and. kl1 == -3222)then
                if(isinel(121) == 0) return
                the=PMAS(PYCOMP(-211),1)+PMAS(PYCOMP(-3322),1)
                tw=s1724(ss,ilo,0,the)/cskn
                if(ilo == 0) return
                lc(3)=-211
                lc(4)=-3322
                lc(5)=121

!       K+ + sigma+ to pion+ + p
            else if(kl == 321 .and. kl1 == 3222)then
!       3222 is the flavor code of sigma+
                if(isinel(207) == 0) return
                the=PMAS(PYCOMP(211),1)+PMAS(PYCOMP(2212),1)
                ww=s1713(ss,ilo,0,the)/cskn/10D0
                if(ilo == 0) return
                lc(3)=211
                lc(4)=2212
                lc(5)=207
                ik3=211
                ik4=2212
                call srev(kl,kl1,ik3,ik4,ss,ilo2,fac, &
                 0.5,1.,0.,0.5,1.,0.5,0.,0.5,1.)
                tw=ww*fac

!       K+ + sigma-
            else if(kl == 321 .and. kl1 == 3112)then
                if(isinel(208) == 0)then
                    si1=0D0
                    goto 606
                endif
                ik1=-211
                ik2=2212
                call srev(kl,kl1,ik1,ik2,ss,ilo1,fac, &
                 0.5,1.,0.,0.5,1.,0.5,0.,0.5,1.)
                the=PMAS(PYCOMP(-211),1)+PMAS(PYCOMP(2212),1)
                si1=s0715(ss,ilo1,0,the)*fac
606             if(isinel(209) == 0)then
                    si2=0D0
                    goto 607
                endif
                ik1=111
                ik2=2112
                call srev(kl,kl1,ik1,ik2,ss,ilo2,fac, &
                 0.5,1.,0.,0.5,1.,0.5,0.,0.5,1.)
                the=PMAS(PYCOMP(111),1)+PMAS(PYCOMP(2112),1)
                si2=s2325(ss,ilo2,0,the)*fac
607             if(ilo1 == 0.and.ilo2 == 0) return
                if(si1 < 1D-6.and.si2 < 1D-6) return
                sit=si1+si2
                s1=si1/sit
                rlus=PYR(1)
                if(rlus <= s1)then
                    ik1=-211
                    ik2=2212
                    ic=208
!       K+ + sigma- to pion- + p
                    goto 609
                endif
                ik1=111
                ik2=2112
                ic=209
!       K+ + sigma- to pion0 + n
609             lc(3)=ik1
                lc(4)=ik2
                lc(5)=ic
                tw=sit/cskn/10D0

!       K+ + sigma0
            else if(kl == 321 .and. kl1 == 3212)then
                if(isinel(210) == 0)then
                    si1=0D0
                    goto 610
                endif
                ik1=211
                ik2=2112
                call srev(kl,kl1,ik1,ik2,ss,ilo1,fac, &
                 0.5,1.,0.,0.5,1.,0.5,0.,0.5,1.)
                the=PMAS(PYCOMP(211),1)+PMAS(PYCOMP(2112),1)
                si1=s1724(ss,ilo1,0,the)*fac
610             if(isinel(211) == 0)then
                    si2=0D0
                    goto 611
                endif
                ik1=111
                ik2=2212
                call srev(kl,kl1,ik1,ik2,ss,ilo2,fac, &
                 0.5,1.,0.,0.5,1.,0.5,0.,0.5,1.)
                the=PMAS(PYCOMP(111),1)+PMAS(PYCOMP(2212),1)
                si2=s2314(ss,ilo2,0,the)*fac
611             if(ilo1 == 0.and.ilo2 == 0) return
                if(si1 < 1D-6.and.si2 < 1D-6) return
                sit=si1+si2
                s1=si1/sit
                rlus=PYR(1)
                if(rlus <= s1)then
                    ik1=211
                    ik2=2112
                    ic=210
!       K+ + sigma0 to pion+ + n
                    goto 612
                endif
                ik1=111
                ik2=2212
                ic=211
!       K+ + sigma0 to pion0 + p
612             lc(3)=ik1
                lc(4)=ik2
                lc(5)=ic
                tw=sit/cskn/10D0

!       k0 + sigma+
            else if(kl == 311 .and. kl1 == 3222)then
                if(isinel(214) == 0)then
                    si1=0D0
                    goto 616
                endif
                ik1=211
                ik2=2112
                call srev(kl,kl1,ik1,ik2,ss,ilo1,fac, &
                 0.5,1.,0.,0.5,1.,0.5,0.,0.5,1.)
                the=PMAS(PYCOMP(211),1)+PMAS(PYCOMP(2112),1)
                si1=s1724(ss,ilo1,0,the)*fac
616             if(isinel(215) == 0)then
                    si2=0D0
                    goto 617
                endif
                ik1=111
                ik2=2212
                call srev(kl,kl1,ik1,ik2,ss,ilo2,fac, &
                 0.5,1.,0.,0.5,1.,0.5,0.,0.5,1.)
                the=PMAS(PYCOMP(111),1)+PMAS(PYCOMP(2212),1)
                si2=s1724(ss,ilo2,0,the)*fac
617             if(ilo1 == 0.and.ilo2 == 0) return
                if(si1 < 1D-6.and.si2 < 1D-6) return
                sit=si1+si2
                s1=si1/sit
                rlus=PYR(1)
                if(rlus <= s1)then
                    ik1=211
                    ik2=2112
                    ic=214
!       K+ + sigma+ to pion+ + n
                    goto 618
                endif
                ik1=111
                ik2=2212
                ic=215
!       K+ + sigma+ to pion0 + p
618             lc(3)=ik1
                lc(4)=ik2
                lc(5)=ic
                tw=sit/cskn/10D0

!       k0 + sigma- to pion- +n
            else if(kl == 311 .and. kl1 == 3112)then
!       3112 is the flavor code of sigma-
                if(isinel(216) == 0) return
                the=PMAS(PYCOMP(-211),1)+PMAS(PYCOMP(2112),1)
                ww=s1724(ss,ilo,0,the)/cskn/10D0
                if(ilo == 0) return
                lc(3)=-211
                lc(4)=2112
                lc(5)=216
                ik3=-211
                ik4=2112
                call srev(kl,kl1,ik3,ik4,ss,ilo2,fac, &
                 0.5,1.,0.,0.5,1.,0.5,0.,0.5,1.)
                tw=ww*fac

!       k0 + sigma0
            else if(kl == 311 .and. kl1 == 3212)then
                if(isinel(217) == 0)then
                    si1=0D0
                    goto 619
                endif
                ik1=-211
                ik2=2212
                call srev(kl,kl1,ik1,ik2,ss,ilo1,fac, &
                 0.5,1.,0.,0.5,1.,0.5,0.,0.5,1.)
                the=PMAS(PYCOMP(-211),1)+PMAS(PYCOMP(2212),1)
                si1=s07123(ss,ilo1,0,the)*fac
619             if(isinel(218) == 0)then
                    si2=0D0
                    goto 620
                endif
                ik1=111
                ik2=2112
                call srev(kl,kl1,ik1,ik2,ss,ilo2,fac, &
                 0.5,1.,0.,0.5,1.,0.5,0.,0.5,1.)
                the=PMAS(PYCOMP(111),1)+PMAS(PYCOMP(2112),1)
                si2=s1724(ss,ilo2,0,the)*fac
620             if(ilo1 == 0.and.ilo2 == 0) return
                if(si1 < 1D-6.and.si2 < 1D-6) return
                sit=si1+si2
                s1=si1/sit
                rlus=PYR(1)
                if(rlus <= s1)then
                    ik1=-211
                    ik2=2212
                    ic=217
!       k0 + sigma0 to pion- + p
                    goto 621
                endif
                ik1=111
                ik2=2112
                ic=218
!       k0 + sigma0 to pion0 + n
621             lc(3)=ik1
                lc(4)=ik2
                lc(5)=ic
                tw=sit/cskn/10D0

!       K- + sigma+ba to pion- + pba
            else if(kl == -321 .and. kl1 == -3222)then
                if(isinel(221) == 0) return
                the=PMAS(PYCOMP(-211),1)+PMAS(PYCOMP(-2212),1)
                ww=s1724(ss,ilo,0,the)/cskn/10D0
                if(ilo == 0) return
                lc(3)=-211
                lc(4)=-2212
                lc(5)=221
                ik3=-211
                ik4=-2212
                call srev(kl,kl1,ik3,ik4,ss,ilo1,fac, &
                 0.5,1.,0.,0.5,1.,0.5,0.,0.5,1.)
                tw=ww*fac

!       K- + sigma-ba
            else if(kl == -321 .and. kl1 == -3112)then
                if(isinel(222) == 0)then
                    si1=0D0
                    goto 625
                endif
                ik1=211
                ik2=-2212
                call srev(kl,kl1,ik1,ik2,ss,ilo1,fac, &
                 0.5,1.,0.,0.5,1.,0.5,0.,0.5,1.)
                the=PMAS(PYCOMP(211),1)+PMAS(PYCOMP(-2212),1)
                si1=s1724(ss,ilo1,0,the)*fac
625             if(isinel(223) == 0)then
                    si2=0D0
                    goto 626
                endif
                ik1=111
                ik2=-2112
                call srev(kl,kl1,ik1,ik2,ss,ilo2,fac, &
                 0.5,1.,0.,0.5,1.,0.5,0.,0.5,1.)
                the=PMAS(PYCOMP(111),1)+PMAS(PYCOMP(-2112),1)
                si2=s1724(ss,ilo2,0,the)*fac
626             if(ilo1 == 0.and.ilo2 == 0) return
                if(si1 < 1D-6.and.si2 < 1D-6) return
                sit=si1+si2
                s1=si1/sit
                rlus=PYR(1)
                if(rlus <= s1)then
                    ik1=211
                    ik2=-2212
                    ic=222
!       K- + sigma-ba to pion+ + pba
                    goto 627
                endif
                ik1=111
                ik2=-2112
                ic=223
!       K- + sigma-ba to pion0 + nba
627             lc(3)=ik1
                lc(4)=ik2
                lc(5)=ic
                tw=sit/cskn/10D0

!       K- + sigma0ba
            else if(kl == -321 .and. kl1 == -3212)then
                if(isinel(224) == 0)then
                    si1=0D0
                    goto 628
                endif
                ik1=-211
                ik2=-2112
                call srev(kl,kl1,ik1,ik2,ss,ilo1,fac, &
                 0.5,1.,0.,0.5,1.,0.5,0.,0.5,1.)
                the=PMAS(PYCOMP(-211),1)+PMAS(PYCOMP(-2112),1)
                si1=s1724(ss,ilo1,0,the)*fac
628             if(isinel(225) == 0)then
                    si2=0D0
                    goto 629
                endif
                ik1=111
                ik2=-2212
                call srev(kl,kl1,ik1,ik2,ss,ilo2,fac, &
                 0.5,1.,0.,0.5,1.,0.5,0.,0.5,1.)
                the=PMAS(PYCOMP(111),1)+PMAS(PYCOMP(-2212),1)
                si2=s1724(ss,ilo2,0,the)*fac
629             if(ilo1 == 0.and.ilo2 == 0) return
                if(si1 < 1D-6.and.si2 < 1D-6) return
                sit=si1+si2
                s1=si1/sit
                rlus=PYR(1)
                if(rlus <= s1)then
                    ik1=-211
                    ik2=-2112
                    ic=224
!       K- + sigma0ba to pion- + nba
                    goto 630
                endif
                ik1=111
                ik2=-2212
                ic=225
!       K- + sigma0ba to pion0 + pba
630             lc(3)=ik1
                lc(4)=ik2
                lc(5)=ic
                tw=sit/cskn/10D0

!       k0- + sigma+ba
            else if(kl == -311 .and. kl1 == -3222)then
                if(isinel(228) == 0)then
                    si1=0D0
                    goto 634
                endif
                ik1=-211
                ik2=-2112
                call srev(kl,kl1,ik1,ik2,ss,ilo1,fac, &
                 0.5,1.,0.,0.5,1.,0.5,0.,0.5,1.)
                the=PMAS(PYCOMP(-211),1)+PMAS(PYCOMP(-2112),1)
                si1=s1724(ss,ilo1,0,the)*fac
634             if(isinel(229) == 0)then
                    si2=0D0
                    goto 635
                endif
                ik1=111
                ik2=-2212
                call srev(kl,kl1,ik1,ik2,ss,ilo2,fac, &
                 0.5,1.,0.,0.5,1.,0.5,0.,0.5,1.)
                the=PMAS(PYCOMP(111),1)+PMAS(PYCOMP(-2212),1)
                si2=s1724(ss,ilo2,0,the)*fac
635             if(ilo1 == 0.and.ilo2 == 0) return
                if(si1 < 1D-6.and.si2 < 1D-6) return
                sit=si1+si2
                s1=si1/sit
                rlus=PYR(1)
                if(rlus <= s1)then
                    ik1=-211
                    ik2=-2112
                    ic=228
!       k0ba + sigma+ba to pion- + nba
                    goto 636
                endif
                ik1=111
                ik2=-2212
                ic=229
!       k0ba + sigma+ba to pion0 + pba
636             lc(3)=ik1
                lc(4)=ik2
                lc(5)=ic
                tw=sit/cskn/10D0

!       k0- + sigma-ba to pion+ + nba
            else if(kl == -311 .and. kl1 == -3112)then
                if(isinel(230) == 0) return
                the=PMAS(PYCOMP(211),1)+PMAS(PYCOMP(-2112),1)
                ww=s1724(ss,ilo,0,the)/cskn/10D0
                if(ilo == 0) return
                lc(3)=211
                lc(4)=-2112
                lc(5)=230
                ik3=211
                ik4=-2112
                call srev(kl,kl1,ik3,ik4,ss,ilo1,fac, &
                 0.5,1.,0.,0.5,1.,0.5,0.,0.5,1.)
                tw=ww*fac

!       k0- + sigma0-
            else if(kl == -311 .and. kl1 == -3212)then
                if(isinel(231) == 0)then
                    si1=0D0
                    goto 637
                endif
                ik1=211
                ik2=-2212
                call srev(kl,kl1,ik1,ik2,ss,ilo1,fac, &
                 0.5,1.,0.,0.5,1.,0.5,0.,0.5,1.)
                the=PMAS(PYCOMP(211),1)+PMAS(PYCOMP(-2212),1)
                si1=s1724(ss,ilo1,0,the)*fac
637             if(isinel(232) == 0)then
                    si2=0D0
                    goto 638
                endif
                ik1=111
                ik2=-2112
                call srev(kl,kl1,ik1,ik2,ss,ilo2,fac, &
                 0.5,1.,0.,0.5,1.,0.5,0.,0.5,1.)
                the=PMAS(PYCOMP(111),1)+PMAS(PYCOMP(-2112),1)
                si2=s1724(ss,ilo2,0,the)*fac
638             if(ilo1 == 0.and.ilo2 == 0) return
                if(si1 < 1D-6.and.si2 < 1D-6) return
                sit=si1+si2
                s1=si1/sit
                rlus=PYR(1)
                if(rlus <= s1)then
                    ik1=211
                    ik2=-2212
                    ic=231
!       k0- + sigma0- to pion+ + pba
                    goto 639
                endif
                ik1=111
                ik2=-2112
                ic=232
!       k0- + sigma0- to pion0 + nba
639             lc(3)=ik1
                lc(4)=ik2
                lc(5)=ic
                tw=sit/cskn/10D0

            else
                write(*,*) "Warning! KY_coll-Sigma: some channels " &
                        // "are missing. KF1, KF2 =", kl, kl1
                return
            endif

        end if

        ioo = 1


        return
        end



!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
        subroutine KCascade_coll( kl, kl1, ss, lc, tw, ioo )
!!      A part of "prod" to deal with K + Cascade --> ...
!       Finds production and fills up lc(i,3-5), tw(i).
!       Kaon + Cascade channels are defined as 139-146, 235-248, 253, 257, 265,
!                                              270, 274, 282, 297-310, 325-330.
!       kl, kl1: the KF code.
!       ss: the total energy (invariant mass) of two hadrons.
!       lc: collision list.
!       tw: the ratio of cross section of (special inela.)/tot.
!       ioo: flag of elastic (0) and inelastic (1) treatment.
        IMPLICIT DOUBLE PRECISION(A-H, O-Z)
        IMPLICIT INTEGER(I-N)
        INTEGER PYCOMP
        COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4)
        common/sa10_h/csnn,cspin,cskn,cspipi,cspsn,cspsm,rcsit,ifram, &
         iabsb,iabsm,i_sigma_AQM,csspn,csspm
        common/sa20_h/t0,cspipiKK,dep,ddt,edipi,epin,ecsnn,ekn,ecspsn,ecspsm, &
         rnt,rnp,ecsspn,ecsspm
        common/iloval/ilo1,ilo2,ilo3,ilo4,ilo5,ilo6,ilo7,ilo8,ilo9
        common/count_h/isinel(2000)
        integer :: lc(6)


        ioo = 0
        ilo = 1

!       K + Cascade
        if( kl1 > 0 )then

!       K- + cascade- to pion- + Omega-
            if(kl == -321 .and. kl1 == 3312)then
                if(isinel(139) == 0) return
                the=PMAS(PYCOMP(-211),1)+PMAS(PYCOMP(3334),1)
                tw=s1724(ss,ilo,0,the)/cskn
                if(ilo == 0) return
                lc(3)=-211
                lc(4)=3334
                lc(5)=139

!       K- + cascade0 to pion0 + Omega-
            else if(kl == -321 .and. kl1 == 3322)then
                if(isinel(141) == 0) return
                the=PMAS(PYCOMP(111),1)+PMAS(PYCOMP(3334),1)
                tw=s1724(ss,ilo,0,the)/cskn
                if(ilo == 0) return
                lc(3)=111
                lc(4)=3334
                lc(5)=141

!       k0- + cascade- to pion0 + Omega-
            else if(kl == -311 .and. kl1 == 3312)then
                if(isinel(140) == 0) return
                the=PMAS(PYCOMP(111),1)+PMAS(PYCOMP(3334),1)
                tw=s1724(ss,ilo,0,the)/cskn
                if(ilo == 0) return
                lc(3)=111
                lc(4)=3334
                lc(5)=140

!       k0- + cascade0 to pion+ + Omega-
            else if(kl == -311 .and. kl1 == 3322)then
                if(isinel(142) == 0) return
                the=PMAS(PYCOMP(211),1)+PMAS(PYCOMP(3334),1)
                tw=s1724(ss,ilo,0,the)/cskn
                if(ilo == 0) return
                lc(3)=211
                lc(4)=3334
                lc(5)=142

!       K+ + cascade-
            else if(kl == 321 .and. kl1 == 3312)then
                if(isinel(235) == 0)then
                    si1=0D0
                    goto 699
                endif
                ik1=211
                ik2=3112
                call srev(kl,kl1,ik1,ik2,ss,ilo1,fac, &
                 0.5,0.5,0.,0.5,1.,1.,0.,0.5,1.)
                the=PMAS(PYCOMP(211),1)+PMAS(PYCOMP(3112),1)
                si1=s1724(ss,ilo1,0,the)*fac
699             if(isinel(236) == 0)then
                    si2=0D0
                    goto 643
                endif
                ik1=-211
                ik2=3222
                call srev(kl,kl1,ik1,ik2,ss,ilo2,fac, &
                 0.5,0.5,0.,0.5,1.,1.,0.,0.5,1.)
                the=PMAS(PYCOMP(-211),1)+PMAS(PYCOMP(3222),1)
                si2=s1724(ss,ilo2,0,the)*fac
643             if(isinel(237) == 0)then
                    si3=0D0
                    goto 644
                endif
                ik1=111
                ik2=3122
                call srev(kl,kl1,ik1,ik2,ss,ilo3,fac, &
                 0.5,0.5,0.,0.5,1.,0.,0.,0.5,1.)
                the=PMAS(PYCOMP(111),1)+PMAS(PYCOMP(3122),1)
                si3=s1724(ss,ilo3,0,the)*fac
644             if(isinel(238) == 0)then
                    si4=0D0
                    goto 6430
                endif
                ik1=111
                ik2=3212
                call srev(kl,kl1,ik1,ik2,ss,ilo4,fac, &
                0.5,0.5,0.,0.5,1.,1.,0.,0.5,1.)
                the=PMAS(PYCOMP(111),1)+PMAS(PYCOMP(3212),1)
                si4=s1724(ss,ilo4,0,the)*fac
6430            if(isinel(253) == 0)then
                    si5=0D0
                    goto 6440
                endif
                ik1=-321
                ik2=2212
                call srev(kl,kl1,ik1,ik2,ss,ilo5,fac, &
                0.5,0.5,0.,0.5,1.,0.,0.,0.5,1.)
                the=PMAS(PYCOMP(321),1)+PMAS(PYCOMP(2212),1)
                si5=s1724(ss,ilo5,0,the)*fac
6440            if(isinel(265) == 0)then
                    si6=0D0
                    goto 645
                endif
                ik1=-311
                ik2=2112
                call srev(kl,kl1,ik1,ik2,ss,ilo6,fac, &
                0.5,0.5,0.,0.5,1.,0.,0.,0.5,1.)
                the=PMAS(PYCOMP(311),1)+PMAS(PYCOMP(2112),1)
                si6=s1724(ss,ilo6,0,the)*fac
645             if(ilo1 == 0 .and. ilo2 == 0 .and. ilo3 == 0 .and. ilo4 == 0 &
                    .and. ilo5 == 0 .and. ilo6 == 0) return
                if(si1 < 1D-6.and.si2 < 1D-6.and.si3 < 1D-6 .and. &
                    si4 < 1D-6.and.si5 < 1D-6.and.si6 < 1D-6) return
                si12=si1+si2
                si13=si12+si3
                si14=si13+si4
                si15=si14+si5
                si16=si15+si6
                s1=si1/si16
                s2=si12/si16
                s3=si13/si16
                s4=si14/si16
                s5=si15/si16
                rlu1=PYR(1)
                if(rlu1 <= s1)then
                    ik1=211
                    ik2=3112
                    ic=235
!       K+ + cascade- to pion+ + sigma-
                    goto 646
                endif
                if(rlu1 > s1 .and. rlu1 <= s2)then
                    ik1=-211
                    ik2=3222
                    ic=236
!       K+ + cascade- to pion- + sigma+
                    goto 646
                endif
                if(rlu1 > s2 .and. rlu1 <= s3)then
                    ik1=111
                    ik2=3122
                    ic=237
!       K+ + cascade- to pion0 + lambda0
                    goto 646
                endif
                if(rlu1 > s3 .and. rlu1 <= s4)then
                    ik1=111
                    ik2=3212
                    ic=238
!       K+ + cascade- to pion0 + sigma0
                    goto 646
                endif
                if(rlu1 > s4 .and. rlu1 <= s5)then
                    ik1=-321
                    ik2=2212
                    ic=253
!       K+ + cascade- to k- + p
                    goto 646
                endif
                ik1=-311
                ik2=2112
                ic=265
!       K+ + cascade- to k0- + n
646             lc(3)=ik1
                lc(4)=ik2
                lc(5)=ic
                tw=si16/cskn/10D0

!       k0 + cascade-
            else if(kl == 311 .and. kl1 == 3312)then
                if(isinel(243) == 0)then
                    si1=0D0
                    goto 652
                endif
                ik1=-211
                ik2=3122
                call srev(kl,kl1,ik1,ik2,ss,ilo1,fac, &
                 0.5,0.5,0.,0.5,1.,0.,0.,0.5,1.)
                the=PMAS(PYCOMP(-211),1)+PMAS(PYCOMP(3122),1)
                si1=s1724(ss,ilo1,0,the)*fac
652             if(isinel(244) == 0)then
                    si2=0D0
                    goto 653
                endif
                ik1=-211
                ik2=3212
                call srev(kl,kl1,ik1,ik2,ss,ilo2,fac, &
                 0.5,0.5,0.,0.5,1.,1.,0.,0.5,1.)
                the=PMAS(PYCOMP(-211),1)+PMAS(PYCOMP(3212),1)
                si2=s1724(ss,ilo2,0,the)*fac
653             if(isinel(245) == 0)then
                    si3=0D0
                    goto 6540
                endif
                ik1=111
                ik2=3112
                call srev(kl,kl1,ik1,ik2,ss,ilo3,fac, &
                0.5,0.5,0.,0.5,1.,1.,0.,0.5,1.)
                the=PMAS(PYCOMP(111),1)+PMAS(PYCOMP(3112),1)
                si3=s1724(ss,ilo3,0,the)*fac
6540            if(isinel(257) == 0)then
                    si4=0D0
                    goto 654
                endif
                ik1=-321
                ik2=2112
                call srev(kl,kl1,ik1,ik2,ss,ilo4,fac, &
                0.5,0.5,0.,0.5,1.,1.,0.,0.5,1.)
                the=PMAS(PYCOMP(321),1)+PMAS(PYCOMP(2112),1)
                si4=s1724(ss,ilo4,0,the)*fac
654             if(ilo1 == 0 .and. ilo2 == 0 .and. ilo3 == 0 &
                    .and. ilo4 == 0) return
                if(si1 < 1D-6.and.si2 < 1D-6.and.si3 < 1D-6 &
                    .and.si4 < 1D-6) return
                si12=si1+si2
                si13=si12+si3
                si14=si13+si4
                s1=si1/si14
                s2=si12/si14
                s3=si13/si14
                rlu1=PYR(1)
                if(rlu1 <= s1)then
                    ik1=-211
                    ik2=3122
                    ic=243
!       k0 + cascade- to pion- + lambda0
                    goto 655
                endif
                if(rlu1 > s1 .and. rlu1 <= s2)then
                    ik1=-211
                    ik2=3212
                    ic=244
!       k0 + cascade- to pion- + sigma0
                    goto 655
                endif
                if(rlu1 > s2 .and. rlu1 <= s3)then
                    ik1=111
                    ik2=3112
                    ic=245
!       k0 + cascade- to pion0 + sigma-
                    goto 655
                endif
                ik1=-321
                ik2=2112
                ic=257
!       k0 + cascade- to k- + n
655             lc(3)=ik1
                lc(4)=ik2
                lc(5)=ic
                tw=si14/cskn/10D0

!       K+ + cascade0
            else if(kl == 321 .and. kl1 == 3322)then
                if(isinel(298) == 0)then
                    si1=0D0
                    goto 768
                endif
                ik1=211
                ik2=3212
                call srev(kl,kl1,ik1,ik2,ss,ilo1,fac, &
                 0.5,0.5,0.,0.5,1.,1.,0.,0.5,1.)
                the=PMAS(PYCOMP(211),1)+PMAS(PYCOMP(3212),1)
                si1=s1724(ss,ilo1,0,the)*fac
768             if(isinel(299) == 0)then
                    si2=0D0
                    goto 769
                endif
                ik1=211
                ik2=3122
                call srev(kl,kl1,ik1,ik2,ss,ilo2,fac, &
                 0.5,0.5,0.,0.5,1.,0.,0.,0.5,1.)
                the=PMAS(PYCOMP(211),1)+PMAS(PYCOMP(3122),1)
                si2=s1724(ss,ilo2,0,the)*fac
769             if(isinel(301) == 0)then
                    si3=0D0
                    goto 770
                endif
                ik1=111
                ik2=3222
                call srev(kl,kl1,ik1,ik2,ss,ilo3,fac, &
                 0.5,0.5,0.,0.5,1.,1.,0.,0.5,1.)
                the=PMAS(PYCOMP(111),1)+PMAS(PYCOMP(3222),1)
                si3=s1724(ss,ilo3,0,the)*fac
770             if(isinel(326) == 0)then
                    si4=0D0
                    goto 771
                endif
                ik1=-311
                ik2=2212
                call srev(kl,kl1,ik1,ik2,ss,ilo4,fac, &
                 0.5,0.5,0.,0.5,0.5,0.5,0.,0.5,1.)
                the=PMAS(PYCOMP(-311),1)+PMAS(PYCOMP(2212),1)
                si4=s1724(ss,ilo4,0,the)*fac
771             if(ilo1 == 0 .and. ilo2 == 0 .and. ilo3 == 0 .and. ilo4 == 0 &
                    ) return
                if(si1 < 1D-6.and.si2 < 1D-6.and.si3 < 1D-6 &
                    .and.si4 < 1D-6) return
                si12=si1+si2
                si13=si12+si3
                si14=si13+si4
                s1=si1/si14
                s2=si12/si14
                s3=si13/si14
                rlu1=PYR(1)
                if(rlu1 <= s1)then
                    ik1=211
                    ik2=3212
                    ic=298
!       K+ + cascade0 to pion+ + sigma0
                    goto 772
                endif
                if(rlu1 > s1 .and. rlu1 <= s2)then
                    ik1=211
                    ik2=3122
                    ic=299
!       K+ + cascade0 to pion+ + lambda
                    goto 772
                endif
                if(rlu1 > s2 .and. rlu1 <= s3)then
                    ik1=111
                    ik2=3222
                    ic=301
!       K+ + cascade0 to pion0 + sigma+
                    goto 772
                endif
                ik1=-311
                ik2=2212
                ic=326
!       K+ + cascade0 to k0- + p
772             lc(3)=ik1
                lc(4)=ik2
                lc(5)=ic
                tw=si14/cskn/10D0

!       k0 + cascad0
            else if(kl == 311 .and. kl1 == 3322)then
                if(isinel(297) == 0)then
                    si1=0D0
                    goto 778
                endif
                ik1=211
                ik2=3112
                call srev(kl,kl1,ik1,ik2,ss,ilo1,fac, &
                 0.5,0.5,0.,0.5,1.,1.,0.,0.5,1.)
                the=PMAS(PYCOMP(211),1)+PMAS(PYCOMP(3112),1)
                si1=s1724(ss,ilo1,0,the)*fac
778             if(isinel(300) == 0)then
                    si2=0D0
                    goto 779
                endif
                ik1=-211
                ik2=3222
                call srev(kl,kl1,ik1,ik2,ss,ilo2,fac, &
                 0.5,0.5,0.,0.5,1.,1.,0.,0.5,1.)
                the=PMAS(PYCOMP(-211),1)+PMAS(PYCOMP(3222),1)
                si2=s1724(ss,ilo2,0,the)*fac
779             if(isinel(302) == 0)then
                    si3=0D0
                    goto 780
                endif
                ik1=111
                ik2=3212
                call srev(kl,kl1,ik1,ik2,ss,ilo3,fac, &
                 0.5,0.5,0.,0.5,1.,1.,0.,0.5,1.)
                the=PMAS(PYCOMP(111),1)+PMAS(PYCOMP(3212),1)
                si3=s1724(ss,ilo3,0,the)*fac
780             if(isinel(303) == 0)then
                    si4=0D0
                    goto 781
                endif
                ik1=111
                ik2=3122
                call srev(kl,kl1,ik1,ik2,ss,ilo4,fac, &
                 0.5,0.5,0.,0.5,1.,0.,0.,0.5,1.)
                the=PMAS(PYCOMP(111),1)+PMAS(PYCOMP(3122),1)
                si4=s1724(ss,ilo4,0,the)*fac
781             if(isinel(325) == 0)then
                    si5=0D0
                    goto 782
                endif
                ik1=-321
                ik2=2212
                call srev(kl,kl1,ik1,ik2,ss,ilo5,fac, &
                 0.5,0.5,0.,0.5,0.5,0.5,0.,0.5,1.)
                the=PMAS(PYCOMP(-321),1)+PMAS(PYCOMP(2212),1)
                si5=s1724(ss,ilo5,0,the)*fac
782             if(isinel(327) == 0)then
                    si6=0D0
                    goto 783
                endif
                ik1=-311
                ik2=2112
                call srev(kl,kl1,ik1,ik2,ss,ilo6,fac, &
                 0.5,0.5,0.,0.5,0.5,0.5,0.,0.5,1.)
                the=PMAS(PYCOMP(-311),1)+PMAS(PYCOMP(2112),1)
                si6=s1724(ss,ilo6,0,the)*fac
783             if(ilo1 == 0 .and. ilo2 == 0 .and. ilo3 == 0 .and. ilo4 == 0 &
                    .and. ilo5 == 0.and. ilo6 == 0) return
                if(si1 < 1D-6.and.si2 < 1D-6.and.si3 < 1D-6 &
                    .and.si4 < 1D-6.and.si5 < 1D-6.and.si6 < 1D-6) return
                si12=si1+si2
                si13=si12+si3
                si14=si13+si4
                si15=si14+si5
                si16=si15+si6
                s1=si1/si16
                s2=si12/si16
                s3=si13/si16
                s4=si14/si16
                s5=si15/si16
                rlu1=PYR(1)
                if(rlu1 <= s1)then
                    ik1=211
                    ik2=3112
                    ic=297
!       k0 + cascade0 to pion+ + sigma-
                    goto 784
                endif
                if(rlu1 > s1 .and. rlu1 <= s2)then
                    ik1=-211
                    ik2=3222
                    ic=300
!       k0 + cascade0 to pion- + sigma+
                    goto 784
                endif
                if(rlu1 > s2 .and. rlu1 <= s3)then
                    ik1=111
                    ik2=3212
                    ic=302
!       k0 + cascade0 to pion0 + sigma0
                    goto 784
                endif
                if(rlu1 > s3 .and. rlu1 <= s4)then
                    ik1=111
                    ik2=3122
                    ic=303
!       k0 + cascade0 to pion0 + lambda
                    goto 784
                endif
                if(rlu1 > s4 .and. rlu1 <= s5)then
                    ik1=-321
                    ik2=2212
                    ic=325
!       k0 + cascade0 to k- + p
                    goto 784
                endif
                ik1=-311
                ik2=2112
                ic=327
!       k0 + cascade0 to k0- + n
784             lc(3)=ik1
                lc(4)=ik2
                lc(5)=ic
                tw=si16/cskn/10D0

            else
                write(*,*) "Warning! KCascade_coll-Cacade: some channels " &
                        // "are missing. KF1, KF2 =", kl, kl1
                return
            end if

!       K + Cascadebar
        else

!       K+ + cascade-ba to pion+ + Omega-ba
            if(kl == 321 .and. kl1 == -3312)then
                if(isinel(143) == 0) return
                the=PMAS(PYCOMP(211),1)+PMAS(PYCOMP(-3334),1)
                tw=s1724(ss,ilo,0,the)/cskn
                if(ilo == 0) return
                lc(3)=211
                lc(4)=-3334
                lc(5)=143

!       K+ + cascade0- to pion0 + Omega-ba
            else if(kl == 321 .and. kl1 == -3322)then
                if(isinel(145) == 0) return
                the=PMAS(PYCOMP(111),1)+PMAS(PYCOMP(-3334),1)
                tw=s1724(ss,ilo,0,the)/cskn
                if(ilo == 0) return
                lc(3)=111
                lc(4)=-3334
                lc(5)=145

!       k0 + cascade-ba to pion0 + Omega-ba
            else if(kl == 311 .and. kl1 == -3312)then
                if(isinel(144) == 0) return
                the=PMAS(PYCOMP(111),1)+PMAS(PYCOMP(-3334),1)
                tw=s1724(ss,ilo,0,the)/cskn
                if(ilo == 0) return
                lc(3)=111
                lc(4)=-3334
                lc(5)=144

!       k0 + cascade0- to pion- + Omega-ba
            else if(kl == 311 .and. kl1 == -3322)then
                if(isinel(146) == 0) return
                the=PMAS(PYCOMP(-211),1)+PMAS(PYCOMP(-3334),1)
                tw=s1724(ss,ilo,0,the)/cskn
                if(ilo == 0) return
                lc(3)=-211
                lc(4)=-3334
                lc(5)=146

!       K- + cascade-ba
            else if(kl == -321 .and. kl1 == -3312)then
                if(isinel(239) == 0)then
                    si1=0D0
                    goto 647
                endif
                ik1=211
                ik2=-3222
                call srev(kl,kl1,ik1,ik2,ss,ilo1,fac, &
                 0.5,0.5,0.,0.5,1.,1.,0.,0.5,1.)
                the=PMAS(PYCOMP(211),1)+PMAS(PYCOMP(-3222),1)
                si1=s1724(ss,ilo1,0,the)*fac
647             if(isinel(240) == 0)then
                    si2=0D0
                    goto 648
                endif
                ik1=-211
                ik2=-3112
                call srev(kl,kl1,ik1,ik2,ss,ilo2,fac, &
                 0.5,0.5,0.,0.5,1.,1.,0.,0.5,1.)
                the=PMAS(PYCOMP(-211),1)+PMAS(PYCOMP(-3112),1)
                si2=s1724(ss,ilo2,0,the)*fac
648             if(isinel(241) == 0)then
                    si3=0D0
                    goto 649
                endif
                ik1=111
                ik2=-3122
                call srev(kl,kl1,ik1,ik2,ss,ilo3,fac, &
                 0.5,0.5,0.,0.5,1.,0.,0.,0.5,1.)
                the=PMAS(PYCOMP(111),1)+PMAS(PYCOMP(-3122),1)
                si3=s1724(ss,ilo3,0,the)*fac
649             if(isinel(242) == 0)then
                    si4=0D0
                    goto 6500
                endif
                ik1=111
                ik2=-3212
                call srev(kl,kl1,ik1,ik2,ss,ilo4,fac, &
                0.5,0.5,0.,0.5,1.,1.,0.,0.5,1.)
                the=PMAS(PYCOMP(111),1)+PMAS(PYCOMP(-3212),1)
                si4=s1724(ss,ilo4,0,the)*fac
6500            if(isinel(270) == 0)then
                    si5=0D0
                    goto 6501
                endif
                ik1=321
                ik2=-2212
                call srev(kl,kl1,ik1,ik2,ss,ilo5,fac, &
                0.5,0.5,0.,0.5,1.,1.,0.,0.5,1.)
                the=PMAS(PYCOMP(321),1)+PMAS(PYCOMP(2212),1)
                si5=s1724(ss,ilo5,0,the)*fac
6501            if(isinel(282) == 0)then
                    si6=0D0
                    goto 650
                endif
                ik1=311
                ik2=-2112
                call srev(kl,kl1,ik1,ik2,ss,ilo6,fac, &
                0.5,0.5,0.,0.5,1.,1.,0.,0.5,1.)
                the=PMAS(PYCOMP(311),1)+PMAS(PYCOMP(2112),1)
                si6=s1724(ss,ilo6,0,the)*fac
650             if(ilo1 == 0 .and. ilo2 == 0 .and. ilo3 == 0 .and. ilo4 == 0 &
                    .and. ilo5 == 0 .and. ilo6 == 0) return
                if(si1 < 1D-6.and.si2 < 1D-6.and.si3 < 1D-6.and. &
                    si4 < 1D-6.and.si5 < 1D-6.and.si6 < 1D-6) return
                si12=si1+si2
                si13=si12+si3
                si14=si13+si4
                si15=si14+si5
                si16=si15+si6
                s1=si1/si16
                s2=si12/si16
                s3=si13/si16
                s4=si14/si16
                s5=si15/si16
                rlu1=PYR(1)
                if(rlu1 <= s1)then
                    ik1=211
                    ik2=-3222
                    ic=239
!       K- + cascade-ba to pion+ + sigma+ba
                    goto 651
                endif
                if(rlu1 > s1 .and. rlu1 <= s2)then
                    ik1=-211
                    ik2=-3112
                    ic=240
!       K- + cascade-ba to pion- + sigma-ba
                    goto 651
                endif
                if(rlu1 > s2 .and. rlu1 <= s3)then
                    ik1=111
                    ik2=-3122
                    ic=241
!       K- + cascade-ba to pion0 + lambda0-
                    goto 651
                endif
                if(rlu1 > s3 .and. rlu1 <= s4)then
                    ik1=111
                    ik2=-3212
                    ic=242
!       K- + cascade-ba to pion0 + sigma0-
                    goto 651
                endif
                if(rlu1 > s4 .and. rlu1 <= s5)then
                    ik1=321
                    ik2=-2212
                    ic=270
!       K- + cascade-ba to k+ + pba
                    goto 651
                endif
                ik1=311
                ik2=-2112
                ic=282
!       K- + cascade-ba to k0 +nba
651             lc(3)=ik1
                lc(4)=ik2
                lc(5)=ic
                tw=si16/cskn/10D0

!       k0- + cascade-ba
            else if(kl == -311 .and. kl1 == -3312)then
                if(isinel(246) == 0)then
                    si1=0D0
                    goto 656
                endif
                ik1=211
                ik2=-3122
                call srev(kl,kl1,ik1,ik2,ss,ilo1,fac, &
                 0.5,0.5,0.,0.5,1.,0.,0.,0.5,1.)
                the=PMAS(PYCOMP(211),1)+PMAS(PYCOMP(-3122),1)
                si1=s1724(ss,ilo1,0,the)*fac
656             if(isinel(247) == 0)then
                    si2=0D0
                    goto 657
                endif
                ik1=211
                ik2=-3212
                call srev(kl,kl1,ik1,ik2,ss,ilo2,fac, &
                 0.5,0.5,0.,0.5,1.,1.,0.,0.5,1.)
                the=PMAS(PYCOMP(211),1)+PMAS(PYCOMP(-3212),1)
                si2=s1724(ss,ilo2,0,the)*fac
657             if(isinel(248) == 0)then
                    si3=0D0
                    goto 6580
                endif
                ik1=111
                ik2=-3112
                call srev(kl,kl1,ik1,ik2,ss,ilo3,fac, &
                0.5,0.5,0.,0.5,1.,1.,0.,0.5,1.)
                the=PMAS(PYCOMP(111),1)+PMAS(PYCOMP(-3112),1)
                si3=s1724(ss,ilo3,0,the)*fac
6580            if(isinel(274) == 0)then
                    si4=0D0
                    goto 658
                endif
                ik1=321
                ik2=-2112
                call srev(kl,kl1,ik1,ik2,ss,ilo4,fac, &
                0.5,0.5,0.,0.5,1.,1.,0.,0.5,1.)
                the=PMAS(PYCOMP(321),1)+PMAS(PYCOMP(2112),1)
                si4=s1724(ss,ilo4,0,the)*fac
658             if(ilo1 == 0 .and. ilo2 == 0 .and. ilo3 == 0 &
                    .and. ilo4 == 0) return
                if(si1 < 1D-6.and.si2 < 1D-6.and.si3 < 1D-6 &
                    .and.si4 < 1D-6) return
                si12=si1+si2
                si13=si12+si3
                si14=si13+si4
                s1=si1/si14
                s2=si12/si14
                s3=si13/si14
                rlu1=PYR(1)
                if(rlu1 <= s1)then
                    ik1=211
                    ik2=-3122
                    ic=246
!       k0- + cascade-ba to pion+ + lambda0-
                    goto 659
                endif
                if(rlu1 > s1 .and. rlu1 <= s2)then
                    ik1=211
                    ik2=-3212
                    ic=247
!       k0- + cascade-ba to pion+ + sigma0-
                    goto 659
                endif
                if(rlu1 > s2 .and. rlu1 <= s3)then
                    ik1=111
                    ik2=-3112
                    ic=248
!       k0- + cascade-ba to pion0 + sigma-ba
                    goto 659
                endif
                ik1=321
                ik2=-2112
                ic=274
!       k0- + cascade-ba to k+ + nba
659             lc(3)=ik1
                lc(4)=ik2
                lc(5)=ic
                tw=si14/cskn/10D0

!       K- + cascad0-
            else if(kl == -321 .and. kl1 == -3322)then
                if(isinel(306) == 0)then
                    si1=0D0
                    goto 773
                endif
                ik1=-211
                ik2=-3212
                call srev(kl,kl1,ik1,ik2,ss,ilo1,fac, &
                 0.5,0.5,0.,0.5,1.,1.,0.,0.5,1.)
                the=PMAS(PYCOMP(-211),1)+PMAS(PYCOMP(-3212),1)
                si1=s1724(ss,ilo1,0,the)*fac
773             if(isinel(307) == 0)then
                    si2=0D0
                    goto 774
                endif
                ik1=-211
                ik2=-3122
                call srev(kl,kl1,ik1,ik2,ss,ilo2,fac, &
                 0.5,0.5,0.,0.5,1.,0.,0.,0.5,1.)
                the=PMAS(PYCOMP(-211),1)+PMAS(PYCOMP(3122),1)
                si2=s1724(ss,ilo2,0,the)*fac
774             if(isinel(308) == 0)then
                    si3=0D0
                    goto 775
                endif
                ik1=111
                ik2=-3222
                call srev(kl,kl1,ik1,ik2,ss,ilo3,fac, &
                 0.5,0.5,0.,0.5,1.,1.,0.,0.5,1.)
                the=PMAS(PYCOMP(111),1)+PMAS(PYCOMP(-3222),1)
                si3=s1724(ss,ilo3,0,the)*fac
775             if(isinel(329) == 0)then
                    si4=0D0
                    goto 776
                endif
                ik1=311
                ik2=-2212
                call srev(kl,kl1,ik1,ik2,ss,ilo4,fac, &
                 0.5,0.5,0.,0.5,0.5,0.5,0.,0.5,1.)
                the=PMAS(PYCOMP(311),1)+PMAS(PYCOMP(-2212),1)
                si4=s1724(ss,ilo4,0,the)*fac
776             if(ilo1 == 0 .and. ilo2 == 0 .and. ilo3 == 0 .and. ilo4 == 0 &
                    ) return
                if(si1 < 1D-6.and.si2 < 1D-6.and.si3 < 1D-6 &
                    .and.si4 < 1D-6) return
                si12=si1+si2
                si13=si12+si3
                si14=si13+si4
                s1=si1/si14
                s2=si12/si14
                s3=si13/si14
                rlu1=PYR(1)
                if(rlu1 <= s1)then
                    ik1=-211
                    ik2=-3212
                    ic=306
!       K- + cascade0- to pion- + sigma0-
                    goto 777
                endif
                if(rlu1 > s1 .and. rlu1 <= s2)then
                    ik1=-211
                    ik2=-3122
                    ic=307
!       K- + cascade0- to pion- + lambda-
                    goto 777
                endif
                if(rlu1 > s2 .and. rlu1 <= s3)then
                    ik1=111
                    ik2=-3222
                    ic=308
!       K- + cascade0- to pion0 + sigma+ba
                    goto 777
                endif
                ik1=311
                ik2=-2212
                ic=329
!       K- + cascade0- to k0 + p-
777             lc(3)=ik1
                lc(4)=ik2
                lc(5)=ic
                tw=si14/cskn/10D0

!       k0- + cascad0-
            else if(kl == -311 .and. kl1 == -3322)then
                if(isinel(304) == 0)then
                    si1=0D0
                    goto 785
                endif
                ik1=211
                ik2=-3222
                call srev(kl,kl1,ik1,ik2,ss,ilo1,fac, &
                 0.5,0.5,0.,0.5,1.0,1.0,0.,0.5,1.)
                the=PMAS(PYCOMP(211),1)+PMAS(PYCOMP(-3222),1)
                si1=s1724(ss,ilo1,0,the)*fac
785             if(isinel(305) == 0)then
                    si2=0D0
                    goto 786
                endif
                ik1=-211
                ik2=-3112
                call srev(kl,kl1,ik1,ik2,ss,ilo2,fac, &
                 0.5,0.5,0.,0.5,1.0,1.0,0.,0.5,1.)
                the=PMAS(PYCOMP(-211),1)+PMAS(PYCOMP(-3112),1)
                si2=s1724(ss,ilo2,0,the)*fac
786             if(isinel(309) == 0)then
                    si3=0D0
                    goto 787
                endif
                ik1=111
                ik2=-3212
                call srev(kl,kl1,ik1,ik2,ss,ilo3,fac, &
                 0.5,0.5,0.,0.5,1.0,1.0,0.,0.5,1.)
                the=PMAS(PYCOMP(111),1)+PMAS(PYCOMP(-3212),1)
                si3=s1724(ss,ilo3,0,the)*fac
787             if(isinel(310) == 0)then
                    si4=0D0
                    goto 788
                endif
                ik1=111
                ik2=-3122
                call srev(kl,kl1,ik1,ik2,ss,ilo4,fac, &
                 0.5,0.5,0.,0.5,1.0,0.,0.,0.5,1.)
                the=PMAS(PYCOMP(111),1)+PMAS(PYCOMP(-3122),1)
                si4=s1724(ss,ilo4,0,the)*fac
788             if(isinel(328) == 0)then
                    si5=0D0
                    goto 789
                endif
                ik1=321
                ik2=-2212
                call srev(kl,kl1,ik1,ik2,ss,ilo5,fac, &
                 0.5,0.5,0.,0.5,0.5,0.5,0.,0.5,1.)
                the=PMAS(PYCOMP(321),1)+PMAS(PYCOMP(-2212),1)
                si5=s1724(ss,ilo5,0,the)*fac
789             if(isinel(330) == 0)then
                    si6=0D0
                    goto 790
                endif
                ik1=311
                ik2=-2112
                call srev(kl,kl1,ik1,ik2,ss,ilo6,fac, &
                 0.5,0.5,0.,0.5,0.5,0.5,0.,0.5,1.)
                the=PMAS(PYCOMP(311),1)+PMAS(PYCOMP(-2112),1)
                si6=s1724(ss,ilo6,0,the)*fac
790             if(ilo1 == 0 .and. ilo2 == 0 .and. ilo3 == 0 .and. ilo4 == 0 &
                    .and. ilo5 == 0.and. ilo6 == 0) return
                if(si1 < 1D-6.and.si2 < 1D-6.and.si3 < 1D-6 &
                    .and.si4 < 1D-6.and.si5 < 1D-6.and.si6 < 1D-6) return
                si12=si1+si2
                si13=si12+si3
                si14=si13+si4
                si15=si14+si5
                si16=si15+si6
                s1=si1/si16
                s2=si12/si16
                s3=si13/si16
                s4=si14/si16
                s5=si15/si16
                rlu1=PYR(1)
                if(rlu1 <= s1)then
                    ik1=211
                    ik2=-3222
                    ic=304
!       K-0 + cascade0- to pion+ + sigma-ba
                    goto 791
                endif
                if(rlu1 > s1 .and. rlu1 <= s2)then
                    ik1=-211
                    ik2=-3112
                    ic=305
!       k0- + cascade0- to pion- + sigma-ba
                    goto 791
                endif
                if(rlu1 > s2 .and. rlu1 <= s3)then
                    ik1=111
                    ik2=-3212
                    ic=309
!       k0- + cascade0- to pion0 + sigma0-
                    goto 791
                endif
                if(rlu1 > s3 .and. rlu1 <= s4)then
                    ik1=111
                    ik2=-3122
                    ic=310
!       k0- + cascade0- to pion0 + lambda-
                    goto 791
                endif
                if(rlu1 > s4 .and. rlu1 <= s5)then
                    ik1=321
                    ik2=-2212
                    ic=328
!       k0- + cascade0- to k+ + p-
                    goto 791
                endif
                ik1=311
                ik2=-2112
                ic=330
!       k0- + cascade0- to k0 + n-
791             lc(3)=ik1
                lc(4)=ik2
                lc(5)=ic
                tw=si16/cskn/10D0

            else
                write(*,*) "Warning! KCascade_coll-Cacadebar: some channels " &
                        // "are missing. KF1, KF2 =", kl, kl1
                return
            endif

        end if

        ioo = 1


        return
        end



!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
        subroutine KOmega_coll( kl, kl1, ss, lc, tw, ioo )
!!      A part of "prod" to deal with K + Omega --> ...
!       Finds production and fills up lc(i,3-5), tw(i).
!       Kaon + Omega channels are defined as 331-338.
!       kl, kl1: the KF code.
!       ss: the total energy (invariant mass) of two hadrons.
!       lc: collision list.
!       tw: the ratio of cross section of (special inela.)/tot.
!       ioo: flag of elastic (0) and inelastic (1) treatment.
        IMPLICIT DOUBLE PRECISION(A-H, O-Z)
        IMPLICIT INTEGER(I-N)
        INTEGER PYCOMP
        COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4)
        common/sa10_h/csnn,cspin,cskn,cspipi,cspsn,cspsm,rcsit,ifram, &
         iabsb,iabsm,i_sigma_AQM,csspn,csspm
        common/sa20_h/t0,cspipiKK,dep,ddt,edipi,epin,ecsnn,ekn,ecspsn,ecspsm, &
         rnt,rnp,ecsspn,ecsspm
        common/iloval/ilo1,ilo2,ilo3,ilo4,ilo5,ilo6,ilo7,ilo8,ilo9
        common/count_h/isinel(2000)
        integer :: lc(6)


        ioo = 0

!       K+ + Omega-
        if(kl == 321 .and. kl1 == 3334)then
            if(isinel(331) == 0)then
                si1=0D0
                goto 792
            endif
            ik1=211
            ik2=3312
            call srev(kl,kl1,ik1,ik2,ss,ilo1,fac, &
             0.5,0.,0.,1.5,1.0,0.5,0.,0.5,1.)
            the=PMAS(PYCOMP(211),1)+PMAS(PYCOMP(3312),1)
            si1=s1724(ss,ilo1,0,the)*fac
792         if(isinel(336) == 0)then
                si2=0D0
                goto 793
            endif
            ik1=111
            ik2=3322
            call srev(kl,kl1,ik1,ik2,ss,ilo2,fac, &
             0.5,0.,0.,1.5,1.0,0.5,0.,0.5,1.)
            the=PMAS(PYCOMP(111),1)+PMAS(PYCOMP(3322),1)
            si2=s1724(ss,ilo2,0,the)*fac
793         if(ilo1 == 0.and.ilo2 == 0) return
            if(si1 < 1D-6.and.si2 < 1D-6) return
            sit=si1+si2
            s1=si1/sit
            rlus=PYR(1)
            if(rlus <= s1)then
                ik1=211
                ik2=3312
                ic=331
!       K+ + Omega- to pion+ + cascade-
                goto 794
            endif
            ik1=111
            ik2=3322
            ic=336
!       K+ + Omega- to pion0 + cascade0
794         lc(3)=ik1
            lc(4)=ik2
            lc(5)=ic
            tw=sit/cskn/10D0

!       K- + Omega-ba
        else if(kl == -321 .and. kl1 == -3334)then
            if(isinel(333) == 0)then
                si1=0D0
                goto 795
            endif
            ik1=-211
            ik2=-3312
            call srev(kl,kl1,ik1,ik2,ss,ilo1,fac, &
             0.5,0.,0.,1.5,1.0,0.5,0.,0.5,1.)
            the=PMAS(PYCOMP(-211),1)+PMAS(PYCOMP(-3312),1)
            si1=s1724(ss,ilo1,0,the)*fac
795         if(isinel(338) == 0)then
                si2=0D0
                goto 796
            endif
            ik1=111
            ik2=-3322
            call srev(kl,kl1,ik1,ik2,ss,ilo2,fac, &
             0.5,0.,0.,1.5,1.0,0.5,0.,0.5,1.)
            the=PMAS(PYCOMP(111),1)+PMAS(PYCOMP(-3322),1)
            si2=s1724(ss,ilo2,0,the)*fac
796         if(ilo1 == 0.and.ilo2 == 0) return
            if(si1 < 1D-6.and.si2 < 1D-6) return
            sit=si1+si2
            s1=si1/sit
            rlus=PYR(1)
            if(rlus <= s1)then
                ik1=-211
                ik2=-3312
                ic=333
!       K- + Omega-ba to pion- + cascade-ba
                goto 797
            endif
            ik1=111
            ik2=-3322
            ic=338
!       K- + Omega-ba to pion0 + cascade0-
797         lc(3)=ik1
            lc(4)=ik2
            lc(5)=ic
            tw=sit/cskn/10D0

!       k0 + Omega-
        else if(kl == 311 .and. kl1 == 3334)then
            if(isinel(332) == 0)then
                si1=0D0
                goto 798
            endif
            ik1=111
            ik2=3312
            call srev(kl,kl1,ik1,ik2,ss,ilo1,fac, &
             0.5,0.,0.,1.5,1.0,0.5,0.,0.5,1.)
            the=PMAS(PYCOMP(111),1)+PMAS(PYCOMP(3312),1)
            si1=s1724(ss,ilo1,0,the)*fac
798         if(isinel(335) == 0)then
                si2=0D0
                goto 799
            endif
            ik1=-211
            ik2=3322
            call srev(kl,kl1,ik1,ik2,ss,ilo2,fac, &
             0.5,0.,0.,1.5,1.0,0.5,0.,0.5,1.)
            the=PMAS(PYCOMP(-211),1)+PMAS(PYCOMP(3322),1)
            si2=s1724(ss,ilo2,0,the)*fac
799         if(ilo1 == 0.and.ilo2 == 0) return
            if(si1 < 1D-6.and.si2 < 1D-6) return
            sit=si1+si2
            s1=si1/sit
            rlus=PYR(1)
            if(rlus <= s1)then
                ik1=111
                ik2=3312
                ic=332
!       k0 + Omega- to pion0 + cascade-
                goto 800
            endif
            ik1=-211
            ik2=3322
            ic=335
!       k0 + Omega- to pion- + cascade0
800         lc(3)=ik1
            lc(4)=ik2
            lc(5)=ic
            tw=sit/cskn/10D0

!       k0- + Omega-ba
        else if(kl == -311 .and. kl1 == -3334)then
            if(isinel(334) == 0)then
                si1=0D0
                goto 801
            endif
            ik1=111
            ik2=-3312
            call srev(kl,kl1,ik1,ik2,ss,ilo1,fac, &
             0.5,0.,0.,1.5,1.0,0.5,0.,0.5,1.)
            the=PMAS(PYCOMP(111),1)+PMAS(PYCOMP(-3312),1)
            si1=s1724(ss,ilo1,0,the)*fac
801         if(isinel(337) == 0)then
                si2=0D0
                goto 802
            endif
            ik1=211
            ik2=-3322
            call srev(kl,kl1,ik1,ik2,ss,ilo2,fac, &
             0.5,0.,0.,1.5,1.0,0.5,0.,0.5,1.)
            the=PMAS(PYCOMP(211),1)+PMAS(PYCOMP(-3322),1)
            si2=s1724(ss,ilo2,0,the)*fac
802         if(ilo1 == 0.and.ilo2 == 0) return
            if(si1 < 1D-6.and.si2 < 1D-6) return
            sit=si1+si2
            s1=si1/sit
            rlus=PYR(1)
            if(rlus <= s1)then
                ik1=111
                ik2=-3312
                ic=334
!       k0- + Omega-ba to pion0 + cascade-ba
                goto 803
            endif
            ik1=211
            ik2=-3322
            ic=337
!       k0- + Omega-ba to pion+ + cascade0-
803         lc(3)=ik1
            lc(4)=ik2
            lc(5)=ic
            tw=sit/cskn/10D0

        else
            write(*,*) "Warning! KOmega_coll: some channels " &
                    // "are missing. KF1, KF2 =", kl, kl1
            return
        endif

        ioo = 1


        return
        end



!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
        subroutine NN_coll( kl, kl1, ss, lc, tw, ioo )
!!      A part of "prod" to deal with N + N --> ...
!       Finds production and fills up lc(i,3-5), tw(i).
!       N + N channels are defined as 173-178.
!       kl, kl1: the KF code.
!       ss: the total energy (invariant mass) of two hadrons.
!       lc: collision list.
!       tw: the ratio of cross section of (special inela.)/tot.
!       ioo: flag of elastic (0) and inelastic (1) treatment.
        IMPLICIT DOUBLE PRECISION(A-H, O-Z)
        IMPLICIT INTEGER(I-N)
        COMMON/PYCIDAT2/KFMAXT,NONT2,PARAM(100)
        common/sa10_h/csnn,cspin,cskn,cspipi,cspsn,cspsm,rcsit,ifram, &
         iabsb,iabsm,i_sigma_AQM,csspn,csspm
        common/sa20_h/t0,cspipiKK,dep,ddt,edipi,epin,ecsnn,ekn,ecspsn,ecspsm, &
         rnt,rnp,ecsspn,ecsspm
        common/iloval/ilo1,ilo2,ilo3,ilo4,ilo5,ilo6,ilo7,ilo8,ilo9
        common/count_h/isinel(2000)
        integer :: lc(6)


        ioo = 0

!       N-Nbar annihilation cross section is assumed equal
!        0.8*(total inelastic cross section), while those of N-Ybar,
!        Nbar-Y annihilation are further divided by 5 (0.8*0.2*sigma_inel).
        para13 = PARAM(1) * 0.1D0 * PARAM(6) * 0.8D0

!       N-N
        if( kl > 0 .AND. kl1 > 0 )then

!       p-p
            if( kl == 2212 .AND. kl1 == 2212 )then
                call ppdelta(ss,lc,tw,ioo)

!       p-n
            else if( ( kl == 2212 .AND. kl1 == 2112 ) &
                .OR. ( kl == 2112 .AND. kl1 == 2212 ) )then
                call pndelta(ss,lc,tw,ioo)

!       n-n
            else if( kl == 2112 .AND. kl1 == 2112 )then
                call nndelta(ss,lc,tw,ioo)

            else
                write(*,*) "Warning! NN_coll-NN: some channels are missing. " &
                        // "KF1, KF2 =", kl, kl1
            end if

!       Nbar-Nbar
        else if( kl < 0 .AND. kl1 < 0 )then

!       pbar-pbar
            if( kl == -2212 .AND. kl1 == -2212 )then
                call pbar_pbar_delta(ss,lc,tw,ioo)

!       pbar-nbar
            else if( ( kl ==  -2212 .AND. kl1 == -2112 ) &
                .OR. ( kl ==  -2112 .AND. kl1 == -2212 ) )then
                call pbar_nbar_delta(ss,lc,tw,ioo)

!       nbar-nbar
            else if( kl == -2112 .AND. kl1 == -2112 )then
                call nbar_nbar_delta(ss,lc,tw,ioo)

            else
                write(*,*) "Warning! NN_coll-NbarNbar: some channels " &
                        // "are missing. KF1, KF2 =", kl, kl1
            end if

!       N-Nbar annihilation.
        else

!       pbar p annihilation
            if( ( kl == -2212 .AND. kl1 == 2212 ) &
                .OR. ( kl1 == -2212 .AND. kl == 2212 ) )then
                if(isinel(597) == 0) return
                tw=para13/csnn
                lc(3)=113
                lc(4)=223
                lc(5)=597
                ioo = 1

!       pbar n annihilation
            else if( ( kl == -2212 .AND. kl1 == 2112 ) &
                .OR. ( kl1 == -2212 .AND. kl == 2112 ) )then
                if(isinel(598) == 0) return
                tw=para13/csnn
                lc(3)=-213
                lc(4)=223
                lc(5)=598
                ioo = 1

!       nbar p annihilation
            else if( ( kl == -2112 .AND. kl1 == 2212 ) &
                .OR. ( kl1 == -2112 .AND. kl == 2212 ) )then
                if(isinel(599) == 0) return
                tw=para13/csnn
                lc(3)=213
                lc(4)=223
                lc(5)=599
                ioo = 1

!       nbar n annihilation
            else if( ( kl == -2112 .AND. kl1 == 2112 ) &
                .OR. ( kl1 == -2112 .AND. kl == 2112 ) )then
                if(isinel(600) == 0) return
                tw=para13/csnn
                lc(3)=113
                lc(4)=223
                lc(5)=600
                ioo = 1

            else
                write(*,*) "Warning! NN_coll-NNbar: some channels " &
                        // "are missing. KF1, KF2 =", kl, kl1
            endif

        end if


        return
        end



!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
        subroutine ppdelta(ss,lc,tw,ioo)
!!      A part of "prod" to deal with pp -> ...
        IMPLICIT DOUBLE PRECISION(A-H, O-Z)
        IMPLICIT INTEGER(I-N)
        INTEGER PYCOMP
!       Calculates particle production weight and fills up lc(i,3-5),tw(i).
!       tw : the ratio of cross section of (special inela.)/tot
        COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4)
        COMMON/PYCIDAT2/KFMAXT,NONT2,PARAM(100)
        SAVE /PYCIDAT2/
        common/sa10_h/csnn,cspin,cskn,cspipi,cspsn,cspsm,rcsit,ifram, &
         iabsb,iabsm,i_sigma_AQM,csspn,csspm
        common/count_h/isinel(2000)
        common/iloval/ilo1,ilo2,ilo3,ilo4,ilo5,ilo6,ilo7,ilo8,ilo9
        integer :: lc(6)


        ioo = 0
        if(isinel(174) == 0)then
            sigma1=0.
            goto 522
        endif
        the=PMAS(PYCOMP(2224),1)+PMAS(PYCOMP(2112),1)
        sigma1=snn(ss,ilo1,0,the)
!       Cross section of p + p to Delta++ + n.
522     if(isinel(173) == 0)then
            sigma2=0.
            goto 523
        endif
        the=PMAS(PYCOMP(2214),1)+PMAS(PYCOMP(2212),1)
        sigma2=snn(ss,ilo2,0,the)
!       Cross section of p + p to Delta+ + p.
523     if(ilo1 == 0.and.ilo2 == 0) return
        if(sigma1 < 1D-6 .and. sigma2 < 1D-6) return
        ik1=2224
        ik2=2112
        ic=174
!       p + p to Delta++ + n
        sigm12=sigma1+sigma2
        if(PYR(1) > sigma1/sigm12)then
            ik1=2214
            ik2=2212
            ic=173
!       Cross section of p + p to delta+ + p.
        endif
        lc(3)=ik1
        lc(4)=ik2
        lc(5)=ic
        tw=sigm12/csnn/10.
        ioo=1


        return
        end



!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
        subroutine pndelta(ss,lc,tw,ioo)
!!      A part of "prod" to deal with pn -> ...
        IMPLICIT DOUBLE PRECISION(A-H, O-Z)
        IMPLICIT INTEGER(I-N)
        INTEGER PYCOMP
!       Calculates particle production weight and fills up lc(i,3-5),tw(i).
!       tw : the ratio of cross section of (special inela.)/tot
        COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4)
        COMMON/PYCIDAT2/KFMAXT,NONT2,PARAM(100)
        SAVE /PYCIDAT2/
        common/sa10_h/csnn,cspin,cskn,cspipi,cspsn,cspsm,rcsit,ifram, &
         iabsb,iabsm,i_sigma_AQM,csspn,csspm
        common/count_h/isinel(2000)
        common/iloval/ilo1,ilo2,ilo3,ilo4,ilo5,ilo6,ilo7,ilo8,ilo9
        integer :: lc(6)


        ioo = 0
        if(isinel(175) == 0)then
            sigma1=0.
            goto 524
        endif
        the=PMAS(PYCOMP(2214),1)+PMAS(PYCOMP(2112),1)
        sigma1=snn(ss,ilo1,0,the)
!       cross section of p + n to delta+ + n
524     if(isinel(176) == 0)then
            sigma2=0.
            goto 525
        endif
        the=PMAS(PYCOMP(2114),1)+PMAS(PYCOMP(2212),1)
        sigma2=snn(ss,ilo2,0,the)
!       Cross section of p + n to Delta0 + p.
525     if(ilo1 == 0.and.ilo2 == 0) return
        if(sigma1 < 1D-6 .and. sigma2 < 1D-6) return
        ik1=2214
        ik2=2112
        ic=175
!       p+n to delta+ +  n
        sigm12=sigma1+sigma2
        if(PYR(1) > sigma1/sigm12)then
            ik1=2114
            ik2=2212
            ic=176
!       Cross section of p + n to Delta0 + p.
        endif
        lc(3)=ik1
        lc(4)=ik2
        lc(5)=ic
        tw=sigm12/csnn/10.
        ioo=1


        return
        end



!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
        subroutine nndelta(ss,lc,tw,ioo)
!!      A part of "prod" to deal with nn-> ...
        IMPLICIT DOUBLE PRECISION(A-H, O-Z)
        IMPLICIT INTEGER(I-N)
        INTEGER PYCOMP
!       Calculates particle production weight and fills up lc(i,3-5),tw(i).
!       tw : the ratio of cross section of (special inela.)/tot
        COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4)
        COMMON/PYCIDAT2/KFMAXT,NONT2,PARAM(100)
        SAVE /PYCIDAT2/
        common/sa10_h/csnn,cspin,cskn,cspipi,cspsn,cspsm,rcsit,ifram, &
         iabsb,iabsm,i_sigma_AQM,csspn,csspm
        common/count_h/isinel(2000)
        common/iloval/ilo1,ilo2,ilo3,ilo4,ilo5,ilo6,ilo7,ilo8,ilo9
        integer :: lc(6)


        ioo = 0
        if(isinel(177) == 0)then
            sigma1=0.
            goto 527
        endif
        the=PMAS(PYCOMP(2114),1)+PMAS(PYCOMP(2112),1)
        sigma1=snn(ss,ilo1,0,the)
!       Cross section of n + n to Delta0 + n.
527     if(isinel(178) == 0)then
            sigma2=0.
            goto 526
        endif
        the=PMAS(PYCOMP(1114),1)+PMAS(PYCOMP(2212),1)
        sigma2=snn(ss,ilo2,0,the)
!       Cross section of n + n to delta- + p.
526     if(ilo1 == 0.and.ilo2 == 0) return
        if(sigma1 < 1D-6 .and. sigma2 < 1D-6) return
        ik1=2114
        ik2=2112
        ic=177
!       n + n to Delta0 + n
        sigm12=sigma1+sigma2
        if(PYR(1) > sigma1/sigm12)then
            ik1=1114
            ik2=2212
            ic=178
!       Cross section of n + n to Delta- + p.
        endif
        lc(3)=ik1
        lc(4)=ik2
        lc(5)=ic
        tw=sigm12/csnn/10.
        ioo=1


        return
        end



!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
        subroutine pbar_pbar_delta(ss,lc,tw,ioo)
!!      A part of "prod" to deal with pbar pbar -> ...
        IMPLICIT DOUBLE PRECISION(A-H, O-Z)
        IMPLICIT INTEGER(I-N)
        INTEGER PYCOMP
!       Calculates particle production weight and fills up lc(i,3-5),tw(i).
!       tw : the ratio of cross section of (special inela.)/tot
        COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4)
        COMMON/PYCIDAT2/KFMAXT,NONT2,PARAM(100)
        SAVE /PYCIDAT2/
        common/sa10_h/csnn,cspin,cskn,cspipi,cspsn,cspsm,rcsit,ifram, &
         iabsb,iabsm,i_sigma_AQM,csspn,csspm
        common/count_h/isinel(2000)
        common/iloval/ilo1,ilo2,ilo3,ilo4,ilo5,ilo6,ilo7,ilo8,ilo9
        integer :: lc(6)


        ioo = 0
        if(isinel(550) == 0)then
            sigma1=0.
            goto 522
        endif
        the=PMAS(PYCOMP(-2224),1)+PMAS(PYCOMP(-2112),1)
        sigma1=snn(ss,ilo1,0,the)
!       Cross section of pba + pba to Delta++ba + nba.
522     if(isinel(549) == 0)then
            sigma2=0.
            goto 523
        endif
        the=PMAS(PYCOMP(-2214),1)+PMAS(PYCOMP(-2212),1)
        sigma2=snn(ss,ilo2,0,the)
!       Cross section of pba + pba to Delta+ba + pba.
523     if(ilo1 == 0.and.ilo2 == 0) return
        if(sigma1 < 1D-6 .and. sigma2 < 1D-6) return
        ik1=-2224
        ik2=-2112
        ic=550
!       pba + pba to Delta++ba + nba
        sigm12=sigma1+sigma2
        if(PYR(1) > sigma1/sigm12)then
            ik1=-2214
            ik2=-2212
            ic=549
!       Cross section of pba + pba to Delta+ba + pba.
        endif
        lc(3)=ik1
        lc(4)=ik2
        lc(5)=ic
        tw=sigm12/csnn/10.
        ioo=1


        return
        end



!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
        subroutine pbar_nbar_delta(ss,lc,tw,ioo)
!!      A part of "prod" to deal with pbar nbar -> ...
        IMPLICIT DOUBLE PRECISION(A-H, O-Z)
        IMPLICIT INTEGER(I-N)
        INTEGER PYCOMP
!       Calculates particle production weight and fills up lc(i,3-5),tw(i).
!       tw : the ratio of cross section of (special inela.)/tot
        COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4)
        COMMON/PYCIDAT2/KFMAXT,NONT2,PARAM(100)
        SAVE /PYCIDAT2/
        common/sa10_h/csnn,cspin,cskn,cspipi,cspsn,cspsm,rcsit,ifram, &
         iabsb,iabsm,i_sigma_AQM,csspn,csspm
        common/count_h/isinel(2000)
        common/iloval/ilo1,ilo2,ilo3,ilo4,ilo5,ilo6,ilo7,ilo8,ilo9
        integer :: lc(6)


        ioo = 0
        if(isinel(551) == 0)then
            sigma1=0.
            goto 524
        endif
        the=PMAS(PYCOMP(-2214),1)+PMAS(PYCOMP(-2112),1)
        sigma1=snn(ss,ilo1,0,the)
!       cross section of pba + nba to delta+ba + nba
524     if(isinel(552) == 0)then
            sigma2=0.
            goto 525
        endif
        the=PMAS(PYCOMP(-2114),1)+PMAS(PYCOMP(-2212),1)
        sigma2=snn(ss,ilo2,0,the)
!       Cross section of pba + nba to Delta0ba + pba.
525     if(ilo1 == 0.and.ilo2 == 0) return
        if(sigma1 < 1D-6 .and. sigma2 < 1D-6) return
        ik1=-2214
        ik2=-2112
        ic=551
!       pba + nba to delta+ba +  nba
        sigm12=sigma1+sigma2
        if(PYR(1) > sigma1/sigm12)then
            ik1=-2114
            ik2=-2212
            ic=552
!       Cross section of pba + nba to Delta0ba + pba.
        endif
        lc(3)=ik1
        lc(4)=ik2
        lc(5)=ic
        tw=sigm12/csnn/10.
        ioo=1


        return
        end



!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
        subroutine nbar_nbar_delta(ss,lc,tw,ioo)
!!      A part of "prod" to deal with nbar nbar -> ...
        IMPLICIT DOUBLE PRECISION(A-H, O-Z)
        IMPLICIT INTEGER(I-N)
        INTEGER PYCOMP
!       Calculates particle production weight and fills up lc(i,3-5),tw(i).
!       tw : the ratio of cross section of (special inela.)/tot
        COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4)
        COMMON/PYCIDAT2/KFMAXT,NONT2,PARAM(100)
        SAVE /PYCIDAT2/
        common/sa10_h/csnn,cspin,cskn,cspipi,cspsn,cspsm,rcsit,ifram, &
         iabsb,iabsm,i_sigma_AQM,csspn,csspm
        common/count_h/isinel(2000)
        common/iloval/ilo1,ilo2,ilo3,ilo4,ilo5,ilo6,ilo7,ilo8,ilo9
        integer :: lc(6)


        ioo = 0
        if(isinel(553) == 0)then
            sigma1=0.
            goto 527
        endif
        the=PMAS(PYCOMP(-2114),1)+PMAS(PYCOMP(-2112),1)
        sigma1=snn(ss,ilo1,0,the)
!       Cross section of nba + nba to Delta0ba + nba.
527     if(isinel(554) == 0)then
            sigma2=0.
            goto 526
        endif
        the=PMAS(PYCOMP(-1114),1)+PMAS(PYCOMP(-2212),1)
        sigma2=snn(ss,ilo2,0,the)
!       Cross section of nba + nba to delta-ba + pba.
526     if(ilo1 == 0.and.ilo2 == 0) return
        if(sigma1 < 1D-6 .and. sigma2 < 1D-6) return
        ik1=-2114
        ik2=-2112
        ic=553
!       nba + nba to Delta0ba + nba
        sigm12=sigma1+sigma2
        if(PYR(1) > sigma1/sigm12)then
            ik1=-1114
            ik2=-2212
            ic=554
!       Cross section of nba + nba to Delta-ba + pba.
        endif
        lc(3)=ik1
        lc(4)=ik2
        lc(5)=ic
        tw=sigm12/csnn/10.
        ioo=1


        return
        end



!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
        function snn(ss,ilo,i,the)
!       N + N to N + Delta
!       Parameterized x-section is not correct for N-N.
        IMPLICIT DOUBLE PRECISION(A-H, O-Z)
        IMPLICIT INTEGER(I-N)
        common/sa13/kjp20,non13,vjp20,vjp21,vjp22,vjp23
        ilo=0
        si=0.
        ii=i
        if(ii == 1) goto 30
        if(ss <= the) goto 100
30      ilo=1
        IF(kjp20 == 0)THEN
            si=20*(ss-2.015)**2/(0.015+(ss-2.015)**2)
        ELSE
            si=vjp23
        ENDIF
100     snn=si
        return
        end



!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
        subroutine NDelta_coll( kl, kl1, ss, lc, tw, ioo )
!!      A part of "prod" to deal with N + Delta --> ...
!       Finds production and fills up lc(i,3-5), tw(i).
!       N + Delta channels are defined as 373-378.
!       kl, kl1: the KF code.
!       ss: the total energy (invariant mass) of two hadrons.
!       lc: collision list.
!       tw: the ratio of cross section of (special inela.)/tot.
!       ioo: flag of elastic (0) and inelastic (1) treatment.
        IMPLICIT DOUBLE PRECISION(A-H, O-Z)
        IMPLICIT INTEGER(I-N)
        common/sa10_h/csnn,cspin,cskn,cspipi,cspsn,cspsm,rcsit,ifram, &
         iabsb,iabsm,i_sigma_AQM,csspn,csspm
        common/sa20_h/t0,cspipiKK,dep,ddt,edipi,epin,ecsnn,ekn,ecspsn,ecspsm, &
         rnt,rnp,ecsspn,ecsspm
        common/iloval/ilo1,ilo2,ilo3,ilo4,ilo5,ilo6,ilo7,ilo8,ilo9
        common/count_h/isinel(2000)
        integer :: lc(6)


        ioo = 0
        ilo = 1

!       N + Delta
        if( kl > 0 .AND. kl1 > 0 )then

!       Delta++ + n to p + p
            if((kl == 2224 .and. kl1 == 2112).or. &
                (kl1 == 2224 .and. kl == 2112))then
                if(isinel(373) == 0) return
                ik3=2212
                ik4=2212
                call srev(kl,kl1,ik3,ik4,ss,ilo,fac, &
                 1.5,0.5,1.5,0.5,0.5,0.5,0.5,0.5,0.5)
                if(ilo == 0) return
                lc(3)=2212
                lc(4)=2212
                lc(5)=373
                ww=snn(ss,ilo1,1,0.d0)/csnn/10D0
                tw=ww*fac

!       Delta+ + n to p + n
            else if((kl == 2214 .and. kl1 == 2112).or. &
                (kl1 == 2214 .and. kl == 2112))then
                if(isinel(374) == 0) return
                ik3=2212
                ik4=2112
                call srev(kl,kl1,ik3,ik4,ss,ilo,fac, &
                 1.5,0.5,1.5,0.5,0.5,0.5,0.5,0.5,1.0)
                if(ilo == 0) return
                lc(3)=2212
                lc(4)=2112
                lc(5)=374
                ww=snn(ss,ilo1,1,0.d0)/csnn/10D0
                tw=ww*fac

!       Delta+ + p to p + p
            else if((kl == 2214 .and. kl1 == 2212).or. &
                (kl1 == 2214 .and. kl == 2212))then
                if(isinel(375) == 0) return
                ik3=2212
                ik4=2212
                call srev(kl,kl1,ik3,ik4,ss,ilo,fac, &
                 1.5,0.5,1.5,0.5,0.5,0.5,0.5,0.5,0.5)
                if(ilo == 0) return
                lc(3)=2212
                lc(4)=2212
                lc(5)=375
                ww=snn(ss,ilo1,1,0.d0)/csnn/10D0
                tw=ww*fac

!       Delta0 + p to p + n
            else if((kl == 2114 .and. kl1 == 2212).or. &
                (kl1 == 2114 .and. kl == 2212))then
                if(isinel(376) == 0) return
                ik3=2212
                ik4=2112
                call srev(kl,kl1,ik3,ik4,ss,ilo,fac, &
                 1.5,0.5,1.5,0.5,0.5,0.5,0.5,0.5,1.0)
                if(ilo == 0) return
                lc(3)=2212
                lc(4)=2112
                lc(5)=376
                ww=snn(ss,ilo1,1,0.d0)/csnn/10D0
                tw=ww*fac

!       Delta0 + n to n + n
            else if((kl == 2114 .and. kl1 == 2112).or. &
                (kl1 == 2114 .and. kl == 2112))then
                if(isinel(377) == 0) return
                ik3=2112
                ik4=2112
                call srev(kl,kl1,ik3,ik4,ss,ilo,fac, &
                 1.5,0.5,1.5,0.5,0.5,0.5,0.5,0.5,0.5)
                if(ilo == 0) return
                lc(3)=2112
                lc(4)=2112
                lc(5)=377
                ww=snn(ss,ilo1,1,0.d0)/csnn/10D0
                tw=ww*fac

!       Delta- + p to n + n
            else if((kl == 1114 .and. kl1 == 2212).or. &
                (kl1 == 1114 .and. kl == 2212))then
                if(isinel(378) == 0) return
                ik3=2112
                ik4=2112
                call srev(kl,kl1,ik3,ik4,ss,ilo,fac, &
                 1.5,0.5,1.5,0.5,0.5,0.5,0.5,0.5,0.5)
                if(ilo == 0) return
                lc(3)=2112
                lc(4)=2112
                lc(5)=378
                ww=snn(ss,ilo1,1,0.d0)/csnn/10D0
                tw=ww*fac

            else
                write(*,*) "Warning! NDelta_coll-N: some channels " &
                        // "are missing. KF1, KF2 =", kl, kl1
                return
            endif

!       Nbar + Deltabar
        else

!       Delta++ba + nba to pba + pba
            if((kl == -2224 .and. kl1 == -2112).or. &
                (kl1 == -2224 .and. kl == -2112))then
                if(isinel(555) == 0) return
                ik3=-2212
                ik4=-2212
                call srev(kl,kl1,ik3,ik4,ss,ilo,fac, &
                 1.5,0.5,1.5,0.5,0.5,0.5,0.5,0.5,0.5)
                if(ilo == 0) return
                lc(3)=-2212
                lc(4)=-2212
                lc(5)=555
                ww=snn(ss,ilo1,1,0.d0)/csnn/10D0
                tw=ww*fac

!       Delta+ba + nba to pba + nba
            else if((kl == -2214 .and. kl1 == -2112).or. &
                (kl1 == -2214 .and. kl == -2112))then
                if(isinel(556) == 0) return
                ik3=-2212
                ik4=-2112
                call srev(kl,kl1,ik3,ik4,ss,ilo,fac, &
                 1.5,0.5,1.5,0.5,0.5,0.5,0.5,0.5,1.0)
                if(ilo == 0) return
                lc(3)=-2212
                lc(4)=-2112
                lc(5)=556
                ww=snn(ss,ilo1,1,0.d0)/csnn/10D0
                tw=ww*fac

!       Delta+ba + pba to pba + pba
            else if((kl == -2214 .and. kl1 == -2212).or. &
                (kl1 == -2214 .and. kl == -2212))then
                if(isinel(557) == 0) return
                ik3=-2212
                ik4=-2212
                call srev(kl,kl1,ik3,ik4,ss,ilo,fac, &
                 1.5,0.5,1.5,0.5,0.5,0.5,0.5,0.5,0.5)
                if(ilo == 0) return
                lc(3)=-2212
                lc(4)=-2212
                lc(5)=557
                ww=snn(ss,ilo1,1,0.d0)/csnn/10D0
                tw=ww*fac

!       Delta0ba + pba to pba + nba
            else if((kl == -2114 .and. kl1 == -2212).or. &
                (kl1 == -2114 .and. kl == -2212))then
                if(isinel(558) == 0) return
                ik3=-2212
                ik4=-2112
                call srev(kl,kl1,ik3,ik4,ss,ilo,fac, &
                 1.5,0.5,1.5,0.5,0.5,0.5,0.5,0.5,1.0)
                if(ilo == 0) return
                lc(3)=-2212
                lc(4)=-2112
                lc(5)=558
                ww=snn(ss,ilo1,1,0.d0)/csnn/10D0
                tw=ww*fac

!       Delta0ba + nba to nba + nba
            else if((kl == -2114 .and. kl1 == -2112).or. &
                (kl1 == -2114 .and. kl == -2112))then
                if(isinel(559) == 0) return
                ik3=-2112
                ik4=-2112
                call srev(kl,kl1,ik3,ik4,ss,ilo,fac, &
                 1.5,0.5,1.5,0.5,0.5,0.5,0.5,0.5,0.5)
                if(ilo == 0) return
                lc(3)=-2112
                lc(4)=-2112
                lc(5)=559
                ww=snn(ss,ilo1,1,0.d0)/csnn/10D0
                tw=ww*fac

!       Delta-ba + pba to nba + nba
            else if((kl == -1114 .and. kl1 == -2212).or. &
                (kl1 == -1114 .and. kl == -2212))then
                if(isinel(560) == 0) return
                ik3=-2112
                ik4=-2112
                call srev(kl,kl1,ik3,ik4,ss,ilo,fac, &
                 1.5,0.5,1.5,0.5,0.5,0.5,0.5,0.5,0.5)
                if(ilo == 0) return
                lc(3)=-2112
                lc(4)=-2112
                lc(5)=560
                ww=snn(ss,ilo1,1,0.d0)/csnn/10D0
                tw=ww*fac

            else
                write(*,*) "Warning! NDelta_coll-Nbar: some channels " &
                        // "are missing. KF1, KF2 =", kl, kl1
                return
            endif

        end if

        ioo = 1


        return
        end



!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
        subroutine NY_coll( kl, kl1, ss, lc, tw, ioo )
!!      A part of "prod" to deal with N + Ybar or Nbar + Y --> ...
!       Finds production and fills up lc(i,3-5), tw(i).
!       N + Lambda/Sigma channels are defined as 589-592, 593-596.
!       kl, kl1: the KF code.
!       ss: the total energy (invariant mass) of two hadrons.
!       lc: collision list.
!       tw: the ratio of cross section of (special inela.)/tot.
!       ioo: flag of elastic (0) and inelastic (1) treatment.
        IMPLICIT DOUBLE PRECISION(A-H, O-Z)
        IMPLICIT INTEGER(I-N)
        COMMON/PYCIDAT2/KFMAXT,NONT2,PARAM(100)
        common/sa10_h/csnn,cspin,cskn,cspipi,cspsn,cspsm,rcsit,ifram, &
         iabsb,iabsm,i_sigma_AQM,csspn,csspm
        common/sa20_h/t0,cspipiKK,dep,ddt,edipi,epin,ecsnn,ekn,ecspsn,ecspsm, &
         rnt,rnp,ecsspn,ecsspm
        common/iloval/ilo1,ilo2,ilo3,ilo4,ilo5,ilo6,ilo7,ilo8,ilo9
        common/count_h/isinel(2000)
        integer :: lc(6)


        ioo = 0
        E = ss

!       N-Nbar annihilation cross section is assumed equal 
!        0.8*(total inelastic cross section), while those of N-Ybar,
!        Nbar-Y annihilation are further divided by 5 (0.8*0.2*sigma_inel).
        para13 = PARAM(1) * 0.1D0 * PARAM(6) * 0.8D0

!       Lambda0 pbar annihilation
        if(      ( kl  == 3122 .AND. kl1 == -2212 ) &
            .OR. ( kl1 == 3122 .AND. kl  == -2212 ) )then
            if(isinel(589) == 0) return
            lc(3)=-323
            lc(4)=223
            lc(5)=589
            tw=para13/5./csnn

!       Lambda0 nbar annihilation
        else if( ( kl  == 3122 .AND. kl1 == -2112 ) &
            .OR. ( kl1 == 3122 .AND. kl  == -2112 ) )then
            if(isinel(590) == 0) return
            tw=para13/5./csnn
            lc(3)=-313
            lc(4)=223
            lc(5)=590

!       Sigma0 pbar annihilation
        else if( ( kl  == 3212 .AND. kl1 == -2212 ) &
            .OR. ( kl1 == 3212 .AND. kl  == -2212 ) )then
            if(isinel(591) == 0) return
            tw=para13/5./csnn
            lc(3)=-323
            lc(4)=223
            lc(5)=591

!       Sigma0 nbar annihilation
        else if( ( kl  == 3212 .AND. kl1 == -2112 ) &
            .OR. ( kl1 == 3212 .AND. kl  == -2112 ) )then
            if(isinel(592) == 0) return
            tw=para13/5./csnn
            lc(3)=-313
            lc(4)=223
            lc(5)=592

!       Anti-particle channels.

!       Lambdabar0 p annihilation
        else if( ( kl  == -3122 .AND. kl1 == 2212 ) &
            .OR. ( kl1 == -3122 .AND. kl  == 2212 ) )then
            if(isinel(593) == 0) return
            lc(3)=323
            lc(4)=223
            lc(5)=593
            tw=para13/5./csnn

!       Lambdabar0 n annihilation
        else if( ( kl  == -3122 .AND. kl1 == 2112 ) &
            .OR. ( kl1 == -3122 .AND. kl  == 2112 ) )then
            if(isinel(594) == 0) return
            tw=para13/5./csnn
            lc(3)=313
            lc(4)=223
            lc(5)=594

!       Sigmabar0 p annihilation
        else if( ( kl  == -3212 .AND. kl1 == 2212 ) &
            .OR. ( kl1 == -3212 .AND. kl  == 2212 ) )then
            if(isinel(595) == 0) return
            tw=para13/5./csnn
            lc(3)=323
            lc(4)=223
            lc(5)=595

!       Sigmabar0 n annihilation
        else if( ( kl  == -3212 .AND. kl1 == 2112 ) &
            .OR. ( kl1 == -3212 .AND. kl  == 2112 ) )then
            if(isinel(596) == 0) return
            tw=para13/5./csnn
            lc(3)=313
            lc(4)=223
            lc(5)=596

        else
            write(*,*) "Warning! NY_coll: some channels " &
                    // "are missing. KF1, KF2 =", kl, kl1
            return
        endif

        ioo = 1


        return
        end



!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
        subroutine rhoN_coll( kl, kl1, ss, lc, tw, ioo )
!!      A part of "prod" to deal with rho + N --> ...
!       Finds production and fills up lc(i,3-5), tw(i).
!       rho + N channels are defined as 363-372, 539-548.
!       kl, kl1: the KF code.
!       ss: the total energy (invariant mass) of two hadrons.
!       lc: collision list.
!       tw: the ratio of cross section of (special inela.)/tot.
!       ioo: flag of elastic (0) and inelastic (1) treatment.
        IMPLICIT DOUBLE PRECISION(A-H, O-Z)
        IMPLICIT INTEGER(I-N)
        common/sa10_h/csnn,cspin,cskn,cspipi,cspsn,cspsm,rcsit,ifram, &
         iabsb,iabsm,i_sigma_AQM,csspn,csspm
        common/sa20_h/t0,cspipiKK,dep,ddt,edipi,epin,ecsnn,ekn,ecspsn,ecspsm, &
         rnt,rnp,ecsspn,ecsspm
        common/iloval/ilo1,ilo2,ilo3,ilo4,ilo5,ilo6,ilo7,ilo8,ilo9
        common/count_h/isinel(2000)
        integer :: lc(6)


        ioo = 0
        ilo = 1

!       rho + N
        if( kl1 > 0 )then

!       rho0 + n
            if((kl == 113 .and. kl1 == 2112).or. &
                (kl1 == 113 .and. kl == 2112))then
                if(isinel(363) == 0)then
                    si1=0D0
                    goto 1036
                endif
                ik1=-211
                ik2=2212
                call srev(kl,kl1,ik1,ik2,ss,ilo1,fac, &
                 1.0,0.5,1.0,0.5,1.0,0.5,0.,0.5,1.)
                if(ilo1 == 0)then
                    si1=0D0
                else
                    si1=srho(ss,ilo1,1,0.d0)*fac
                endif
!       Cross section of rho0 + n to pi- + p.
1036            if(isinel(364) == 0)then
                    si2=0D0
                    goto 1038
                endif
                ik1=111
                ik2=2112
                call srev(kl,kl1,ik1,ik2,ss,ilo2,fac, &
                 1.0,0.5,1.0,0.5,1.0,0.5,0.,0.5,1.)
                if(ilo2 == 0)then
                    si2=0D0
                else
! Since threshold energy is check in srev() we set the=0D0 here in sdelta().
                    si2=srho(ss,ilo2,1,0.d0)*fac
                endif
!       Cross section of rho0 + n to pi0 + n.
1038            if(ilo1 == 0 .and. ilo2 == 0) return
                if(si1 < 1D-6.and.si2 < 1D-6) return
                si12=si1+si2
                s1=si1/si12
                rlu1=PYR(1)
                if(rlu1 <= s1)then
                    ik1=-211
                    ik2=2212
                    ic=363
!       Cross section of rho0 + n to pi- + p.
                    goto 1040
                endif
                ik1=111
                ik2=2112
                ic=364
!       Cross section of rho0 + n to pi0 + n.
1040            lc(3)=ik1
                lc(4)=ik2
                lc(5)=ic
                tw=si12/cspin/10D0

!       rho- + n to pi- + n
            else if((kl == -213 .and. kl1 == 2112).or. &
                (kl1 == -213 .and. kl == 2112))then
                if(isinel(365) == 0) return
                ik3=-211
                ik4=2112
                call srev(kl,kl1,ik3,ik4,ss,ilo,fac, &
                 1.0,0.5,1.0,0.5,1.0,0.5,0.,0.5,1.)
                if(ilo == 0) return
                lc(3)=-211
                lc(4)=2112
                lc(5)=365
                ww=srho(ss,ilo1,1,0.d0)/cspin/10D0
                tw=ww*fac

!       rho+ + n
            else if((kl == 213 .and. kl1 == 2112).or. &
                (kl1 == 213 .and. kl == 2112))then
                if(isinel(366) == 0)then
                    si1=0D0
                    goto 1042
                endif
                ik1=111
                ik2=2212
                call srev(kl,kl1,ik1,ik2,ss,ilo1,fac, &
                 1.0,0.5,1.0,0.5,1.0,0.5,0.,0.5,1.)
                if(ilo1 == 0)then
                    si1=0D0
                else
                    si1=srho(ss,ilo1,1,0.d0)*fac
                endif
!       Cross section of rho+ + n to pi0 + p.
1042            if(isinel(367) == 0)then
                    si2=0D0
                    goto 1044
                endif
                ik1=211
                ik2=2112
                call srev(kl,kl1,ik1,ik2,ss,ilo2,fac, &
                 1.0,0.5,1.0,0.5,1.0,0.5,0.,0.5,1.)
                if(ilo2 == 0)then
                    si2=0D0
                else
! Since threshold energy is check in srev() we set the=0D0 here in sdelta().
                    si2=srho(ss,ilo2,1,0.d0)*fac
                endif
!       Cross section of rho+ + n to pi+ + n.
1044            if(ilo1 == 0 .and. ilo2 == 0) return
                if(si1 < 1D-6.and.si2 < 1D-6) return
                si12=si1+si2
                s1=si1/si12
                rlu1=PYR(1)
                if(rlu1 <= s1)then
                    ik1=111
                    ik2=2212
                    ic=366
!       Cross section of rho+ + n to pi0 + p.
                goto 1046
                endif
                ik1=211
                ik2=2112
                ic=367
!       Cross section of rho+ + n to pi+ + n.
1046            lc(3)=ik1
                lc(4)=ik2
                lc(5)=ic
                tw=si12/cspin/10D0

!       rho0 + p
            else if((kl == 113 .and. kl1 == 2212).or. &
                (kl1 == 113 .and. kl == 2212))then
                if(isinel(368) == 0)then
                    si1=0D0
                    goto 1048
                endif
                ik1=111
                ik2=2212
                call srev(kl,kl1,ik1,ik2,ss,ilo1,fac, &
                 1.0,0.5,1.0,0.5,1.0,0.5,0.,0.5,1.)
                if(ilo1 == 0)then
                    si1=0D0
                else
                    si1=srho(ss,ilo1,1,0.d0)*fac
                endif
!       Cross section of rho0 + p to pi0 + p.
1048            if(isinel(369) == 0)then
                    si2=0D0
                    goto 1050
                endif
                ik1=211
                ik2=2112
                call srev(kl,kl1,ik1,ik2,ss,ilo2,fac, &
                 1.0,0.5,1.0,0.5,1.0,0.5,0.,0.5,1.)
                if(ilo2 == 0)then
                    si2=0D0
                else
! Since threshold energy is check in srev() we set the=0D0 here in sdelta().
                    si2=srho(ss,ilo2,1,0.d0)*fac
                endif
!       Cross section of rho0 + p to pi+ + n.
1050            if(ilo1 == 0 .and. ilo2 == 0) return
                if(si1 < 1D-6.and.si2 < 1D-6) return
                si12=si1+si2
                s1=si1/si12
                rlu1=PYR(1)
                if(rlu1 <= s1)then
                    ik1=111
                    ik2=2212
                    ic=368
!       Cross section of rho0 + p to pi0 + p.
                    goto 1052
                endif
                ik1=211
                ik2=2112
                ic=369
!       Cross section of rho0 + p to pi+ + n.
1052            lc(3)=ik1
                lc(4)=ik2
                lc(5)=ic
                tw=si12/cspin/10D0

!       rho- + p
            else if((kl == -213 .and. kl1 == 2212).or. &
                (kl1 == -213 .and. kl == 2212))then
                if(isinel(370) == 0)then
                    si1=0D0
                    goto 1054
                endif
                ik1=111
                ik2=2112
                call srev(kl,kl1,ik1,ik2,ss,ilo1,fac, &
                 1.0,0.5,1.0,0.5,1.0,0.5,0.,0.5,1.)
                if(ilo1 == 0)then
                    si1=0D0
                else
                    si1=srho(ss,ilo1,1,0.d0)*fac
                endif
!       Cross section of rho- + p to pi0 + n.
1054            if(isinel(371) == 0)then
                    si2=0D0
                    goto 1056
                endif
                ik1=-211
                ik2=2212
                call srev(kl,kl1,ik1,ik2,ss,ilo2,fac, &
                 1.0,0.5,1.0,0.5,1.0,0.5,0.,0.5,1.)
                if(ilo2 == 0)then
                    si2=0D0
                else
! Since threshold energy is check in srev() we set the=0D0 here in sdelta().
                    si2=srho(ss,ilo2,1,0.d0)*fac
                endif
!       Cross section of rho- + p to pi- + p.
1056            if(ilo1 == 0 .and. ilo2 == 0) return
                if(si1 < 1D-6.and.si2 < 1D-6) return
                si12=si1+si2
                s1=si1/si12
                rlu1=PYR(1)
                if(rlu1 <= s1)then
                    ik1=111
                    ik2=2112
                    ic=370
!       Cross section of rho- + p to pi0 + n.
                    goto 1058
                endif
                ik1=-211
                ik2=2212
                ic=371
!       Cross section of rho- + p to pi- + p.
1058            lc(3)=ik1
                lc(4)=ik2
                lc(5)=ic
                tw=si12/cspin/10D0

!       rho+ + p to pi+ + p
            else if((kl == 213 .and. kl1 == 2212).or. &
                (kl1 == 213 .and. kl == 2212))then
                if(isinel(372) == 0) return
                ik3=211
                ik4=2212
                call srev(kl,kl1,ik3,ik4,ss,ilo,fac, &
                 1.0,0.5,1.0,0.5,1.0,0.5,0.,0.5,1.)
                if(ilo == 0) return
                lc(3)=211
                lc(4)=2212
                lc(5)=372
                ww=srho(ss,ilo1,1,0.d0)/cspin/10D0
                tw=ww*fac

            else
                write(*,*) "Warning! rhoN_coll-N: some channels " &
                        // "are missing. KF1, KF2 =", kl, kl1
                return
            end if

!       rho + Nbar
        else

!       rho0 + nba
            if((kl == 113 .and. kl1 == -2112).or. &
                (kl1 == 113 .and. kl == -2112))then
                if(isinel(539) == 0)then
                    si1=0D0
                    goto 2036
                endif
                ik1=211
                ik2=-2212
                call srev(kl,kl1,ik1,ik2,ss,ilo1,fac, &
                 1.0,0.5,1.0,0.5,1.0,0.5,0.,0.5,1.)
                if(ilo1 == 0)then
                    si1=0D0
                else
                    si1=srho(ss,ilo1,1,0.d0)*fac
                endif
!       Cross section of rho0 + nba to pi+ + pba.
2036            if(isinel(540) == 0)then
                    si2=0D0
                    goto 2038
                endif
                ik1=111
                ik2=-2112
                call srev(kl,kl1,ik1,ik2,ss,ilo2,fac, &
                 1.0,0.5,1.0,0.5,1.0,0.5,0.,0.5,1.)
                if(ilo2 == 0)then
                    si2=0D0
                else
! Since threshold energy is check in srev() we set the=0D0 here in sdelta().
                    si2=srho(ss,ilo2,1,0.d0)*fac
                endif
!       Cross section of rho0 + nba to pi0 + nba.
2038            if(ilo1 == 0 .and. ilo2 == 0) return
                if(si1 < 1D-6.and.si2 < 1D-6) return
                si12=si1+si2
                s1=si1/si12
                rlu1=PYR(1)
                if(rlu1 <= s1)then
                    ik1=211
                    ik2=-2212
                    ic=539
!       Cross section of rho0 + nba to pi+ + pba.
                    goto 2040
                endif
                ik1=111
                ik2=-2112
                ic=540
!       Cross section of rho0 + nba to pi0 + nba.
2040            lc(3)=ik1
                lc(4)=ik2
                lc(5)=ic
                tw=si12/cspin/10D0

!       rho+ + nba to pi+ + nba
            else if((kl == 213 .and. kl1 == -2112).or. &
                (kl1 == 213 .and. kl == -2112))then
                if(isinel(541) == 0) return
                ik3=211
                ik4=-2112
                call srev(kl,kl1,ik3,ik4,ss,ilo,fac, &
                 1.0,0.5,1.0,0.5,1.0,0.5,0.,0.5,1.)
                if(ilo == 0) return
                lc(3)=211
                lc(4)=-2112
                lc(5)=541
                ww=srho(ss,ilo1,1,0.d0)/cspin/10D0
                tw=ww*fac

!       rho- + nba
            else if((kl == -213 .and. kl1 == -2112).or. &
                (kl1 == -213 .and. kl == -2112))then
                if(isinel(542) == 0)then
                    si1=0D0
                    goto 2042
                endif
                ik1=111
                ik2=-2212
                call srev(kl,kl1,ik1,ik2,ss,ilo1,fac, &
                 1.0,0.5,1.0,0.5,1.0,0.5,0.,0.5,1.)
                if(ilo1 == 0)then
                    si1=0D0
                else
                    si1=srho(ss,ilo1,1,0.d0)*fac
                endif
!       Cross section of rho- + nba to pi0 + pba.
2042            if(isinel(543) == 0)then
                    si2=0D0
                    goto 2044
                endif
                ik1=-211
                ik2=-2112
                call srev(kl,kl1,ik1,ik2,ss,ilo2,fac, &
                 1.0,0.5,1.0,0.5,1.0,0.5,0.,0.5,1.)
                if(ilo2 == 0)then
                    si2=0D0
                else
! Since threshold energy is check in srev() we set the=0D0 here in sdelta().
                    si2=srho(ss,ilo2,1,0.d0)*fac
                endif
!       Cross section of rho- + nba to pi- + nba.
2044            if(ilo1 == 0 .and. ilo2 == 0) return
                if(si1 < 1D-6.and.si2 < 1D-6) return
                si12=si1+si2
                s1=si1/si12
                rlu1=PYR(1)
                if(rlu1 <= s1)then
                    ik1=111
                    ik2=-2212
                    ic=542
!       Cross section of rho- + nba to pi0 + pba.
                    goto 2046
                endif
                ik1=-211
                ik2=-2112
                ic=543
!       Cross section of rho- + nba to pi- + nba.
2046            lc(3)=ik1
                lc(4)=ik2
                lc(5)=ic
                tw=si12/cspin/10D0

!       rho0 + pba
            else if((kl == 113 .and. kl1 == -2212).or. &
                (kl1 == 113 .and. kl == -2212))then
                if(isinel(544) == 0)then
                    si1=0D0
                    goto 2048
                endif
                ik1=111
                ik2=-2212
                call srev(kl,kl1,ik1,ik2,ss,ilo1,fac, &
                 1.0,0.5,1.0,0.5,1.0,0.5,0.,0.5,1.)
                if(ilo1 == 0)then
                    si1=0D0
                else
                    si1=srho(ss,ilo1,1,0.d0)*fac
                endif
!       Cross section of rho0 + pba to pi0 + pba.
2048            if(isinel(545) == 0)then
                    si2=0D0
                    goto 2050
                endif
                ik1=-211
                ik2=-2112
                call srev(kl,kl1,ik1,ik2,ss,ilo2,fac, &
                 1.0,0.5,1.0,0.5,1.0,0.5,0.,0.5,1.)
                if(ilo2 == 0)then
                    si2=0D0
                else
! Since threshold energy is check in srev() we set the=0D0 here in sdelta().
                    si2=srho(ss,ilo2,1,0.d0)*fac
                endif
!       Cross section of rho0 + pba to pi- + nba.
2050            if(ilo1 == 0 .and. ilo2 == 0) return
                if(si1 < 1D-6.and.si2 < 1D-6) return
                si12=si1+si2
                s1=si1/si12
                rlu1=PYR(1)
                if(rlu1 <= s1)then
                    ik1=111
                    ik2=-2212
                    ic=544
!       Cross section of rho0 + pba to pi0 + pba.
                    goto 2052
                endif
                ik1=-211
                ik2=-2112
                ic=545
!       Cross section of rho0 + pba to pi- + nba.
2052            lc(3)=ik1
                lc(4)=ik2
                lc(5)=ic
                tw=si12/cspin/10D0

!       rho+ + pba
            else if((kl == 213 .and. kl1 == -2212).or. &
                (kl1 == 213 .and. kl == -2212))then
                if(isinel(546) == 0)then
                    si1=0D0
                    goto 2054
                endif
                ik1=111
                ik2=-2112
                call srev(kl,kl1,ik1,ik2,ss,ilo1,fac, &
                 1.0,0.5,1.0,0.5,1.0,0.5,0.,0.5,1.)
                if(ilo1 == 0)then
                    si1=0D0
                else
                    si1=srho(ss,ilo1,1,0.d0)*fac
                endif
!       Cross section of rho+ + pba to pi0 + nba.
2054            if(isinel(547) == 0)then
                    si2=0D0
                    goto 2056
                endif
                ik1=211
                ik2=-2212
                call srev(kl,kl1,ik1,ik2,ss,ilo2,fac, &
                 1.0,0.5,1.0,0.5,1.0,0.5,0.,0.5,1.)
                if(ilo2 == 0)then
                    si2=0D0
                else
! Since threshold energy is check in srev() we set the=0D0 here in sdelta().
                    si2=srho(ss,ilo2,1,0.d0)*fac
                endif
!       Cross section of rho+ + pba to pi+ + pba.
2056            if(ilo1 == 0 .and. ilo2 == 0) return
                if(si1 < 1D-6.and.si2 < 1D-6) return
                si12=si1+si2
                s1=si1/si12
                rlu1=PYR(1)
                if(rlu1 <= s1)then
                    ik1=111
                    ik2=-2112
                    ic=546
!       Cross section of rho+ + pba to pi0 + nba.
                    goto 2058
                endif
                ik1=211
                ik2=-2212
                ic=547
!       Cross section of rho+ + pba to pi+ + pba.
2058            lc(3)=ik1
                lc(4)=ik2
                lc(5)=ic
                tw=si12/cspin/10D0

!       rho- + pba to pi- + pba
            else if((kl == -213 .and. kl1 == -2212).or. &
                (kl1 == -213 .and. kl == -2212))then
                if(isinel(548) == 0) return
                ik3=-211
                ik4=-2212
                call srev(kl,kl1,ik3,ik4,ss,ilo,fac, &
                 1.0,0.5,1.0,0.5,1.0,0.5,0.,0.5,1.)
                if(ilo == 0) return
                lc(3)=-211
                lc(4)=-2212
                lc(5)=548
                ww=srho(ss,ilo1,1,0.d0)/cspin/10D0
                tw=ww*fac

            else
                write(*,*) "Warning! rhoN_coll-Nbar: some channels " &
                        // "are missing. KF1, KF2 =", kl, kl1
                return
            end if

        end if

        ioo = 1


        return
        end



!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
        subroutine rho_omega_coll( kl, kl1, ss, lc, tw, ioo )
!!      A part of "prod" to deal with rho + omega --> ...
!       Finds production and fills up lc(i,3-5), tw(i).
!       rho + omega channels are defined as 609-612.
!       kl, kl1: the KF code.
!       ss: the total energy (invariant mass) of two hadrons.
!       lc: collision list.
!       tw: the ratio of cross section of (special inela.)/tot.
!       ioo: flag of elastic (0) and inelastic (1) treatment.
        IMPLICIT DOUBLE PRECISION(A-H, O-Z)
        IMPLICIT INTEGER(I-N)
        COMMON/PYCIDAT2/KFMAXT,NONT2,PARAM(100)
        common/sa10_h/csnn,cspin,cskn,cspipi,cspsn,cspsm,rcsit,ifram, &
         iabsb,iabsm,i_sigma_AQM,csspn,csspm
        common/sa20_h/t0,cspipiKK,dep,ddt,edipi,epin,ecsnn,ekn,ecspsn,ecspsm, &
         rnt,rnp,ecsspn,ecsspm
        common/iloval/ilo1,ilo2,ilo3,ilo4,ilo5,ilo6,ilo7,ilo8,ilo9
        common/count_h/isinel(2000)
        integer :: lc(6)


        ioo = 0
        ilo = 1
        fact1 = 0D0
        fact2 = 0D0

!       N-Nbar annihilation cross section is assumed equal
!        0.8*(total inelastic cross section), while those of N-Ybar,
!        Nbar-Y annihilation are further divided by 5 (0.8*0.2*sigma_inel).
        para13 = PARAM(1) * 0.1D0 * PARAM(6) * 0.8D0

!       rho0 + omega to pba + p or nba + n
        if(      ( kl  == 113 .AND. kl1 == 223 ) &
            .OR. ( kl1 == 113 .AND. kl  == 223 ) )then
            ! To pba + p
            if( isinel(609) == 0 )then
                fact1 = 0D0
                goto 101
            end if
            ik3 = -2212
            ik4 =  2212
            ic3 = 609
            call srev(kl,kl1,ik3,ik4,ss,ilo1,fac, &
             0.0,0.0,1.0,1.0,0.5,0.5,0.5,0.5,1.0)
            fact1 = fac
            if( ilo1 == 0 ) fact1 = 0D0
            ! To nba + n
101         if( isinel(612) == 0 )then
                fact2 = 0D0
                goto 102
            end if
            ik5 = -2112
            ik6 =  2112
            ic5 = 612
            call srev(kl,kl1,ik5,ik6,ss,ilo2,fac, &
             0.0,0.0,1.0,1.0,0.5,0.5,0.5,0.5,1.0)
            fact2 = fac
            if( ilo2 == 0 ) fact2 = 0D0
102         fact = fact1 + fact2
            if( fact1 <= 1D-5 .AND. fact2 <= 1D-5 ) return
            lc(3) = ik3
            lc(4) = ik4
            lc(5) = ic3
            if( PYR(1) > fact1/fact )then
                lc(3) = ik5
                lc(4) = ik6
                lc(5) = ic5
            end if
            tw = fact * para13 / csnn

!       rho- + omega to pba + n
        else if( ( kl  == -213 .AND. kl1 == 223 ) &
            .OR. ( kl1 == -213 .AND. kl  == 223 ) )then
            if( isinel(610) == 0 ) return
            ik3 = -2212
            ik4 =  2112
            call srev(kl,kl1,ik3,ik4,ss,ilo,fac, &
             1.0,0.0,1.0,1.0,0.5,0.5,0.5,0.5,1.0)
            if( ilo == 0 ) return
            lc(3) = -2212
            lc(4) =  2112
            lc(5) = 610
            ww = para13 / csnn
            tw = ww * fac

!       rho+ + omega to nba + p
        else if( ( kl  == 213 .AND. kl1 == 223 ) &
            .OR. ( kl1 == 213 .AND. kl  == 223 ) )then
            if( isinel(611) == 0 ) return
            ik3 = -2112
            ik4 =  2212
            call srev(kl,kl1,ik3,ik4,ss,ilo,fac, &
             1.0,0.0,1.0,1.0,0.5,0.5,0.5,0.5,1.0)
            lc(3) = -2112
            lc(4) =  2212
            lc(5) = 611
            ww = para13 / csnn
            tw = ww * fac

        else
            write(*,*) "Warning! rho_omega_coll: some channels " &
                    // "are missing. KF1, KF2 =", kl, kl1
            return
        endif

        ioo = 1


        return
        end



!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
        subroutine Kstar_omega_coll( kl, kl1, ss, lc, tw, ioo )
!!      A part of "prod" to deal with K* + omega --> ...
!       Finds production and fills up lc(i,3-5), tw(i).
!       K* + omega channels are defined as 601-608.
!       kl, kl1: the KF code.
!       ss: the total energy (invariant mass) of two hadrons.
!       lc: collision list.
!       tw: the ratio of cross section of (special inela.)/tot.
!       ioo: flag of elastic (0) and inelastic (1) treatment.
        IMPLICIT DOUBLE PRECISION(A-H, O-Z)
        IMPLICIT INTEGER(I-N)
        COMMON/PYCIDAT2/KFMAXT,NONT2,PARAM(100)
        common/sa10_h/csnn,cspin,cskn,cspipi,cspsn,cspsm,rcsit,ifram, &
         iabsb,iabsm,i_sigma_AQM,csspn,csspm
        common/sa20_h/t0,cspipiKK,dep,ddt,edipi,epin,ecsnn,ekn,ecspsn,ecspsm, &
         rnt,rnp,ecsspn,ecsspm
        common/iloval/ilo1,ilo2,ilo3,ilo4,ilo5,ilo6,ilo7,ilo8,ilo9
        common/count_h/isinel(2000)
        integer :: lc(6)


        ioo = 0
        fact1 = 0D0
        fact2 = 0D0

!       N-Nbar annihilation cross section is assumed equal
!        0.8*(total inelastic cross section), while those of N-Ybar,
!        Nbar-Y annihilation are further divided by 5 (0.8*0.2*sigma_inel).
        para13 = PARAM(1) * 0.1D0 * PARAM(6) * 0.8D0

!       K*- + omega to Lambda0 / Sigma0 + pbar
        if(      ( kl  == -323 .AND. kl1 == 223 ) &
            .OR. ( kl1 == -323 .AND. kl  == 223 ) )then
            ! To Lambda0 + pbar
            if( isinel(601) == 0 )then
                fact1 = 0D0
                goto 101
            end if
            ik3 = -2212
            ik4 =  3122
            ic3 = 601
            call srev(kl,kl1,ik3,ik4,ss,ilo1,fac, &
             0.5,0.0,1.0,1.0,0.5,0.0,0.5,0.5,1.0)
            fact1 = fac
            if( ilo1 == 0 ) fact1 = 0D0
            ! To Sigma0 + pbar
101         if( isinel(603) == 0 )then
                fact2 = 0D0
                goto 102
            end if
            ik5 = -2212
            ik6 =  3212
            ic5 = 603
            call srev(kl,kl1,ik5,ik6,ss,ilo2,fac, &
             0.5,0.0,1.0,1.0,0.5,1.0,0.5,0.5,1.0)
            fact2 = fac
            if( ilo2 == 0 ) fact2 = 0D0
102         fact = fact1 + fact2
            if( fact1 <= 1D-5 .AND. fact2 <= 1D-5 ) return
            lc(3) = ik3
            lc(4) = ik4
            lc(5) = ic3
            if( PYR(1) > fact1/fact )then
                lc(3) = ik5
                lc(4) = ik6
                lc(5) = ic5
            end if
            tw = fact * para13 / csnn / 5D0

!       K*bar0 + omega to Lambda0 / Sigma0 + nbar
        else if( ( kl  == -313 .AND. kl1 == 223 ) &
            .OR. ( kl1 == -313 .AND. kl  == 223 ) )then
            ! To Lambda0 + nbar
            if( isinel(602) == 0 )then
                fact1 = 0D0
                goto 103
            end if
            ik3 = -2112
            ik4 =  3122
            ic3 = 602
            call srev(kl,kl1,ik3,ik4,ss,ilo1,fac, &
             0.5,0.0,1.0,1.0,0.5,0.0,0.5,0.5,1.0)
            fact1 = fac
            if( ilo1 == 0 ) fact1 = 0D0
            ! To Sigma0 + nbar
103         if( isinel(604) == 0 )then
                fact2 = 0D0
                goto 104
            end if
            ik5 = -2112
            ik6 =  3212
            ic5 = 604
            call srev(kl,kl1,ik5,ik6,ss,ilo2,fac, &
             0.5,0.0,1.0,1.0,0.5,1.0,0.5,0.5,1.0)
            fact2 = fac
            if( ilo2 == 0 ) fact2 = 0D0
104         fact = fact1 + fact2
            if( fact1 <= 1D-5 .AND. fact2 <= 1D-5 ) return
            lc(3) = ik3
            lc(4) = ik4
            lc(5) = ic3
            if( PYR(1) > fact1/fact )then
                lc(3) = ik5
                lc(4) = ik6
                lc(5) = ic5
            end if
            tw = fact * para13 / csnn / 5D0

!       K*+ + omega to Lambdabar0 / Sigmabar0 + p
        else if( ( kl  == 323 .AND. kl1 == 223 ) &
            .OR. ( kl1 == 323 .AND. kl  == 223 ) )then
            ! To Lambdabar0 + p
            if( isinel(605) == 0 )then
                fact1 = 0D0
                goto 201
            end if
            ik3 =  2212
            ik4 = -3122
            ic3 = 605
            call srev(kl,kl1,ik3,ik4,ss,ilo1,fac, &
             0.5,0.0,1.0,1.0,0.5,0.0,0.5,0.5,1.0)
            fact1 = fac
            if( ilo1 == 0 ) fact1 = 0D0
            ! To Sigmabar0 + p
201         if( isinel(607) == 0 )then
                fact2 = 0D0
                goto 202
            end if
            ik5 =  2212
            ik6 = -3212
            ic5 = 607
            call srev(kl,kl1,ik5,ik6,ss,ilo2,fac, &
             0.5,0.0,1.0,1.0,0.5,1.0,0.5,0.5,1.0)
            fact2 = fac
            if( ilo2 == 0 ) fact2 = 0D0
202         fact = fact1 + fact2
            if( fact1 <= 1D-5 .AND. fact2 <= 1D-5 ) return
            lc(3) = ik3
            lc(4) = ik4
            lc(5) = ic3
            if( PYR(1) > fact1/fact )then
                lc(3) = ik5
                lc(4) = ik6
                lc(5) = ic5
            end if
            tw = fact * para13 / csnn / 5D0

!       K*0 + omega to Lambdabar0 / Sigmabar0 + n
        else if( ( kl  == 313 .AND. kl1 == 223 ) &
            .OR. ( kl1 == 313 .AND. kl  == 223 ) )then
            ! To Lambdabar0 + n
            if( isinel(606) == 0 )then
                fact1 = 0D0
                goto 203
            end if
            ik3 =  2112
            ik4 = -3122
            ic3 = 606
            call srev(kl,kl1,ik3,ik4,ss,ilo1,fac, &
             0.5,0.0,1.0,1.0,0.5,0.0,0.5,0.5,1.0)
            fact1 = fac
            if( ilo1 == 0 ) fact1 = 0D0
            ! To Sigmabar0 + n
203         if( isinel(608) == 0 )then
                fact2 = 0D0
                goto 204
            end if
            ik5 =  2112
            ik6 = -3212
            ic5 = 608
            call srev(kl,kl1,ik5,ik6,ss,ilo2,fac, &
             0.5,0.0,1.0,1.0,0.5,1.0,0.5,0.5,1.0)
            fact2 = fac
            if( ilo2 == 0 ) fact2 = 0D0
204         fact = fact1 + fact2
            if( fact1 <= 1D-5 .AND. fact2 <= 1D-5 ) return
            lc(3) = ik3
            lc(4) = ik4
            lc(5) = ic3
            if( PYR(1) > fact1/fact )then
                lc(3) = ik5
                lc(4) = ik6
                lc(5) = ic5
            end if
            tw = fact * para13 / csnn / 5D0

        else
            write(*,*) "Warning! Kstar_omega_coll: some channels " &
                    // "are missing. KF1, KF2 =", kl, kl1
            return
        endif

        ioo = 1


        return
        end



!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
        subroutine DMeson_coll( KF_A, KF_B, E_AB, lc, tw, ioo )
!!      A part of "prod" to deal with D + pion/rho --> ...
!       Finds production and fills up lc(i,3-5), tw(i).
!       D + pion/rho channels are defined as 385-458.
!       D, M: D meson and pion/rho Meson.
!       KF_A, KF_B: the KF code.
!       E_AB: the total energy of two hadrons.
!       lc: collision list.
!       tw: the ratio of cross section of (special inela.)/tot.
!       ioo: flag of elastic (0) and inelastic (1) treatment.
        IMPLICIT DOUBLE PRECISION(A-H, O-Z)
        IMPLICIT INTEGER(I-N)
        INTEGER PYCHGE
        COMMON/PYCIDAT2/KFMAXT,NONT2,PARAM(100)
        common/sa10_h/csnn,cspin,cskn,cspipi,cspsn,cspsm,rcsit,ifram, &
         iabsb,iabsm,i_sigma_AQM,csspn,csspm
        common/count_h/isinel(2000)
        integer, intent(in) :: KF_A, KF_B
        real(kind=8), intent(in) :: E_AB
        integer :: lc(6)


        ioo = 0

!       Makes the order as D + pion/rho.
        i_order = 1
        KF_D    = KF_A
        KF1_D   = MOD( ABS( KF_D ) / 100, 10 )
        KF_M    = KF_B

!       Exchanges the order if first one is not D meson.
        if( KF1_D /= 4 )then
            KF   = KF_D
            KF_D = KF_M
            KF_M = KF
            i_order = -1
        end if
!       Charges of two hadrons.
        iCharge_D = PYCHGE( KF_D )
        iCharge_M = PYCHGE( KF_M )

!       Single production channels: 16 channels, 385-400.
        if( (iCharge_D > 0 .AND. iCharge_M > 0) .OR.  &  ! ++
            (iCharge_D < 0 .AND. iCharge_M < 0) .OR.  &  ! --
            (iCharge_D == 0 .AND. iCharge_M > 0 .AND. &  ! 0+, KF-+
                  KF_D < 0 .AND.      KF_M > 0) .OR.  &  ! 0+, KF-+
            (iCharge_D == 0 .AND. iCharge_M < 0 .AND. &  ! 0-, KF+-
                  KF_D > 0 .AND.      KF_M < 0)       &  ! 0-, KF+-
          )then
            call Dmeson1(KF_D,KF_M,E_AB,lc,tw,ioo,i_order)
!       Dual production channels: 64 channels, 401-464,
!        else if( (iCharge_D == 0 .AND. iCharge_M == 0) .OR.  &   ! 00
!                 (iCharge_D > 0  .AND. iCharge_M < 0)  .OR.  &   ! +-
!                 (iCharge_D < 0  .AND. iCharge_M > 0)  .OR.  &   ! -+
!                 (iCharge_D > 0  .AND. iCharge_M == 0) .OR.  &   ! +0
!                 (iCharge_D < 0  .AND. iCharge_M == 0) .OR.  &   ! -0
!                 (iCharge_D == 0 .AND. iCharge_M > 0   .AND. &   ! 0+, KF++
!                       KF_D > 0  .AND.      KF_M > 0)  .OR.  &   ! 0+, KF++
!                 (iCharge_D == 0 .AND. iCharge_M < 0   .AND. &   ! 0-, KF--
!                       KF_D < 0  .AND.      KF_M < 0)            ! 0-, KF--
!               )then
        else
            call Dmeson2(KF_D,KF_M,E_AB,lc,tw,ioo,i_order)
        end if


        return
        end



!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
        subroutine Dmeson1( KF_D, KF_M, E_AB, lc, tw, ioo, i_od )
!       A part of "prod" to deal with D + pion/rho  --> ...
!       Single production channel: 385-400, total 16 reaction channels.
        IMPLICIT DOUBLE PRECISION(A-H, O-Z)
        IMPLICIT INTEGER(I-N)
        common/sa10_h/csnn,cspin,cskn,cspipi,cspsn,cspsm,rcsit,ifram, &
         iabsb,iabsm,i_sigma_AQM,csspn,csspm
        common/count_h/isinel(2000)
        integer, intent(in) :: KF_D, KF_M, i_od
        real(kind=8), intent(in) :: E_AB
        integer :: lc(6)


        ioo = 0

!       385. D+ + pi+  -->  D*+ + rho+
        if( KF_D == 411 .AND. KF_M == 211 )then
            i_channel = 385
            KF_out_A = 413
            KF_out_B = 213
!       386. D- + pi-  -->  D*- + rho-
        else if( KF_D == -411 .AND. KF_M == -211 )then
            i_channel = 386
            KF_out_A = -413
            KF_out_B = -213
!       387. D*+ + pi+  -->  D+ + rho+
        else if( KF_D == 413 .AND. KF_M == 211 )then
            i_channel = 387
            KF_out_A = 411
            KF_out_B = 213
!       388. D*- + pi-  -->  D- + rho-
        else if( KF_D == -413 .AND. KF_M == -211 )then
            i_channel = 388
            KF_out_A = -411
            KF_out_B = -213
!       389. D+ + rho+  -->  D*+ + pi+
        else if( KF_D == 411 .AND. KF_M == 213 )then
            i_channel = 389
            KF_out_A = 413
            KF_out_B = 211
!       390. D- + rho-  -->  D*- + pi-
        else if( KF_D == -411 .AND. KF_M == -213 )then
            i_channel = 390
            KF_out_A = -413
            KF_out_B = -211
!       391. D*+ + rho+  -->  D+ + pi+
        else if( KF_D == 413 .AND. KF_M == 213 )then
            i_channel = 391
            KF_out_A = 411
            KF_out_B = 211
!       392. D*- + rho-  -->  D- + pi-
        else if( KF_D == -413 .AND. KF_M == -213 )then
            i_channel = 392
            KF_out_A = -411
            KF_out_B = -211
!       393. D0 + pi-  -->  D*0 + rho-
        else if( KF_D == 421 .AND. KF_M == -211 )then
            i_channel = 393
            KF_out_A = 423
            KF_out_B = -213
!       394. Dbar0 + pi+  -->  D*bar0 + rho+
        else if( KF_D == -421 .AND. KF_M == 211 )then
            i_channel = 394
            KF_out_A = -423
            KF_out_B = 213
!       395. D*0 + pi-  -->  D0 + rho-
        else if( KF_D == 423 .AND. KF_M == -211 )then
            i_channel = 395
            KF_out_A = 421
            KF_out_B = -213
!       396. D*bar0 + pi+  -->  Dbar0 + rho+
        else if( KF_D == -423 .AND. KF_M == 211 )then
            i_channel = 396
            KF_out_A = -421
            KF_out_B = 213
!       397. D0 + rho-  -->  D*0 + pi-
        else if( KF_D == 421 .AND. KF_M == -213 )then
            i_channel = 397
            KF_out_A = 423
            KF_out_B = -211
!       398. Dbar0 + rho+  -->  D*bar0 + pi+
        else if( KF_D == -421 .AND. KF_M == 213 )then
            i_channel = 398
            KF_out_A = -423
            KF_out_B = 211
!       399. D*0 + rho-  -->  D0 + pi-
        else if( KF_D == 423 .AND. KF_M == -213 )then
            i_channel = 399
            KF_out_A = 421
            KF_out_B = -211
!       400. D*bar0 + rho+  -->  Dbar0 + pi+
        else if( KF_D == -423 .AND. KF_M == 213 )then
            i_channel = 400
            KF_out_A = -421
            KF_out_B = 211
!       Something is wrong.
        else
            write(*,*) "No inel. channel is found in hadcas "       // &
                       "Dmeson1(), treated as elastic collision, "  // &
                       "KF_D, KF_M =", KF_D, KF_M
            return
        end if

!       Inelastic channel switch.
        if( isinel( i_channel ) == 0 ) return
!       Threshold energy.
        E_thresh = PYMASS( KF_out_A ) + PYMASS( KF_out_B )
        if( E_AB <= E_thresh ) return

!       Order exchanging corresponding to that made in "DMeson_coll".
        if( i_od == -1 )then
            KF = KF_out_A
            KF_out_A = KF_out_B
            KF_out_B = KF
        end if

!       Feedback.
        lc(3) = KF_out_A
        lc(4) = KF_out_B
        lc(5) = i_channel
        tw  = rcsit
        ioo = 1


        return
        end



!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
        subroutine Dmeson2( KF_D, KF_M, E_AB, lc, tw, ioo, i_od )
!       A part of "prod" to deal with D + pion/rho  --> ...
!       Dual production channel: 401-464, total 64 reaction channels.
        IMPLICIT DOUBLE PRECISION(A-H, O-Z)
        IMPLICIT INTEGER(I-N)
        common/sa10_h/csnn,cspin,cskn,cspipi,cspsn,cspsm,rcsit,ifram, &
         iabsb,iabsm,i_sigma_AQM,csspn,csspm
        common/count_h/isinel(2000)
        integer, intent(in) :: KF_D, KF_M, i_od
        real(kind=8), intent(in) :: E_AB
        integer :: lc(6)


        ioo = 0

        if( KF_D == 421 .AND. KF_M == 111 )then
!       401. D0 + pi0  -->  D*0 + rho0
            i_channel_1 = 401
            KF_out_A_1 = 423
            KF_out_B_1 = 113
!       402. D0 + pi0  -->  D*+ + rho-
            i_channel_2 = 402
            KF_out_A_2 = 413
            KF_out_B_2 = -213
        else if( KF_D == -421 .AND. KF_M == 111 )then
!       403. Dbar0 + pi0  -->  D*bar0 + rho0
            i_channel_1 = 403
            KF_out_A_1 = -423
            KF_out_B_1 = 113
!       404. Dbar0 + pi0  -->  D*- + rho+
            i_channel_2 = 404
            KF_out_A_2 = -413
            KF_out_B_2 = 213
        else if( KF_D == 423 .AND. KF_M == 111 )then
!       405. D*0 + pi0  -->  D0 + rho0
            i_channel_1 = 405
            KF_out_A_1 = 421
            KF_out_B_1 = 113
!       406. D*0 + pi0  -->  D+ + rho-
            i_channel_2 = 406
            KF_out_A_2 = 411
            KF_out_B_2 = -213
        else if( KF_D == -423 .AND. KF_M == 111 )then
!       407. D*bar0 + pi0  -->  Dbar0 + rho0
            i_channel_1 = 407
            KF_out_A_1 = -421
            KF_out_B_1 = 113
!       408. D*bar0 + pi0  -->  D- + rho+
            i_channel_2 = 408
            KF_out_A_2 = -411
            KF_out_B_2 = 213
        else if( KF_D == 421 .AND. KF_M == 113 )then
!       409. D0 + rho0  -->  D*0 + pi0
            i_channel_1 = 409
            KF_out_A_1 = 423
            KF_out_B_1 = 111
!       410. D0 + rho0  -->  D*+ + pi-
            i_channel_2 = 410
            KF_out_A_2 = 413
            KF_out_B_2 = -211
        else if( KF_D == -421 .AND. KF_M == 113 )then
!       411. Dbar0 + rho0  -->  D*bar0 + pi0
            i_channel_1 = 411
            KF_out_A_1 = -423
            KF_out_B_1 = 111
!       412. Dbar0 + rho0  -->  D*- + pi+
            i_channel_2 = 412
            KF_out_A_2 = -413
            KF_out_B_2 = 211
        else if( KF_D == 423 .AND. KF_M == 113 )then
!       413. D*0 + rho0  -->  D0 + pi0
            i_channel_1 = 413
            KF_out_A_1 = 421
            KF_out_B_1 = 111
!       414. D*0 + rho0  -->  D+ + pi-
            i_channel_2 = 414
            KF_out_A_2 = 411
            KF_out_B_2 = -211
        else if( KF_D == -423 .AND. KF_M == 113 )then
!       415. D*bar0 + rho0  -->  Dbar0 + pi0
            i_channel_1 = 415
            KF_out_A_1 = -421
            KF_out_B_1 = 111
!       416. D*bar0 + rho0  -->  D- + pi+
            i_channel_2 = 416
            KF_out_A_2 = -411
            KF_out_B_2 = 211
        else if( KF_D == 411 .AND. KF_M == -211 )then
!       417. D+ + pi-  -->  D*+ + rho-
            i_channel_1 = 417
            KF_out_A_1 = 413
            KF_out_B_1 = -213
!       418. D+ + pi-  -->  D*0 + rho0
            i_channel_2 = 418
            KF_out_A_2 = 423
            KF_out_B_2 = 113
        else if( KF_D == -411 .AND. KF_M == 211 )then
!       419. D- + pi+  -->  D*- + rho+
            i_channel_1 = 419
            KF_out_A_1 = -413
            KF_out_B_1 = 213
!       420. D- + pi+  -->  D*bar0 + rho0
            i_channel_2 = 420
            KF_out_A_2 = -423
            KF_out_B_2 = 113
        else if( KF_D == 413 .AND. KF_M == -211 )then
!       421. D*+ + pi-  -->  D+ + rho-
            i_channel_1 = 421
            KF_out_A_1 = 411
            KF_out_B_1 = -213
!       422. D*+ + pi-  -->  D0 + rho0
            i_channel_2 = 422
            KF_out_A_2 = 421
            KF_out_B_2 = 113
        else if( KF_D == -413 .AND. KF_M == 211 )then
!       423. D*- + pi+  -->  D- + rho+
            i_channel_1 = 423
            KF_out_A_1 = -411
            KF_out_B_1 = 213
!       424. D*- + pi+  -->  Dbar0 + rho0
            i_channel_2 = 424
            KF_out_A_2 = -421
            KF_out_B_2 = 113
        else if( KF_D == 411 .AND. KF_M == -213 )then
!       425. D+ + rho-  -->  D*+ + pi-
            i_channel_1 = 425
            KF_out_A_1 = 413
            KF_out_B_1 = -211
!       426. D+ + rho-  -->  D*0 + pi0
            i_channel_2 = 426
            KF_out_A_2 = 423
            KF_out_B_2 = 111
        else if( KF_D == -411 .AND. KF_M == 213 )then
!       427. D- + rho+  -->  D*- + pi+
            i_channel_1 = 427
            KF_out_A_1 = -413
            KF_out_B_1 = 211
!       428. D- + rho+  -->  D*bar0 + pi0
            i_channel_2 = 428
            KF_out_A_2 = -423
            KF_out_B_2 = 111
        else if( KF_D == 413 .AND. KF_M == -213 )then
!       429. D*+ + rho-  -->  D+ + pi-
            i_channel_1 = 429
            KF_out_A_1 = 411
            KF_out_B_1 = -211
!       430. D*+ + rho-  -->  D0 + pi0
            i_channel_2 = 430
            KF_out_A_2 = 421
            KF_out_B_2 = 111
        else if( KF_D == -413 .AND. KF_M == 213 )then
!       431. D*- + rho+  -->  D- + pi+
            i_channel_1 = 431
            KF_out_A_1 = -411
            KF_out_B_1 = 211
!       432. D*- + rho+  -->  Dbar0 + pi0
            i_channel_2 = 432
            KF_out_A_2 = -421
            KF_out_B_2 = 111
        else if( KF_D == 411 .AND. KF_M == 111 )then
!       433. D+ + pi0  -->  D*+ + rho0
            i_channel_1 = 433
            KF_out_A_1 = 413
            KF_out_B_1 = 113
!       434. D+ + pi0  -->  D*0 + rho+
            i_channel_2 = 434
            KF_out_A_2 = 423
            KF_out_B_2 = 213
        else if( KF_D == -411 .AND. KF_M == 111 )then
!       435. D- + pi0  -->  D*- + rho0
            i_channel_1 = 435
            KF_out_A_1 = -413
            KF_out_B_1 = 113
!       436. D- + pi0  -->  D*bar0 + rho-
            i_channel_2 = 436
            KF_out_A_2 = -423
            KF_out_B_2 = -213
        else if( KF_D == 413 .AND. KF_M == 111 )then
!       437. D*+ + pi0  -->  D+ + rho0
            i_channel_1 = 437
            KF_out_A_1 = 411
            KF_out_B_1 = 113
!       438. D*+ + pi0  -->  D0 + rho+
            i_channel_2 = 438
            KF_out_A_2 = 421
            KF_out_B_2 = 213
        else if( KF_D == -413 .AND. KF_M == 111 )then
!       439. D*- + pi0  -->  D- + rho0
            i_channel_1 = 439
            KF_out_A_1 = -411
            KF_out_B_1 = 113
!       440. D*- + pi0  -->  Dbar0 + rho-
            i_channel_2 = 440
            KF_out_A_2 = -421
            KF_out_B_2 = -213
        else if( KF_D == 411 .AND. KF_M == 113 )then
!       441. D+ + rho0  -->  D*+ + pi0
            i_channel_1 = 441
            KF_out_A_1 = 413
            KF_out_B_1 = 111
!       442. D+ + rho0  -->  D*0 + pi+
            i_channel_2 = 442
            KF_out_A_2 = 423
            KF_out_B_2 = 211
        else if( KF_D == -411 .AND. KF_M == 113 )then
!       443. D- + rho0  -->  D*- + pi0
            i_channel_1 = 443
            KF_out_A_1 = -413
            KF_out_B_1 = 111
!       444. D- + rho0  -->  D*bar0 + pi-
            i_channel_2 = 444
            KF_out_A_2 = -423
            KF_out_B_2 = -211
        else if( KF_D == 413 .AND. KF_M == 113 )then
!       445. D*+ + rho0  -->  D+ + pi0
            i_channel_1 = 445
            KF_out_A_1 = 411
            KF_out_B_1 = 111
!       446. D*+ + rho0  -->  D0 + pi+
            i_channel_2 = 446
            KF_out_A_2 = 421
            KF_out_B_2 = 211
        else if( KF_D == -413 .AND. KF_M == 113 )then
!       447. D*- + rho0  -->  D- + pi0
            i_channel_1 = 447
            KF_out_A_1 = -411
            KF_out_B_1 = 111
!       448. D*- + rho0  -->  Dbar0 + pi-
            i_channel_2 = 448
            KF_out_A_2 = -421
            KF_out_B_2 = -211
        else if( KF_D == 421 .AND. KF_M == 211 )then
!       449. D0 + pi+  -->  D*0 + rho+
            i_channel_1 = 449
            KF_out_A_1 = 423
            KF_out_B_1 = 213
!       450. D0 + pi+  -->  D*+ + rho0
            i_channel_2 = 450
            KF_out_A_2 = 413
            KF_out_B_2 = 113
        else if( KF_D == -421 .AND. KF_M == -211 )then
!       451. Dbar0 + pi-  -->  D*bar0 + rho-
            i_channel_1 = 451
            KF_out_A_1 = -423
            KF_out_B_1 = -213
!       452. Dbar0 + pi-  -->  D*- + rho0
            i_channel_2 = 452
            KF_out_A_2 = -413
            KF_out_B_2 = 113
        else if( KF_D == 423 .AND. KF_M == 211 )then
!       453. D*0 + pi+  -->  D0 + rho+
            i_channel_1 = 453
            KF_out_A_1 = 421
            KF_out_B_1 = 213
!       454. D*0 + pi+  -->  D+ + rho0
            i_channel_2 = 454
            KF_out_A_2 = 411
            KF_out_B_2 = 113
        else if( KF_D == -423 .AND. KF_M == -211 )then
!       455. D*bar0 + pi-  -->  Dbar0 + rho-
            i_channel_1 = 455
            KF_out_A_1 = -421
            KF_out_B_1 = -213
!       456. D*bar0 + pi-  -->  D- + rho0
            i_channel_2 = 456
            KF_out_A_2 = -411
            KF_out_B_2 = 113
        else if( KF_D == 421 .AND. KF_M == 213 )then
!       457. D0 + rho+  -->  D*0 + pi+
            i_channel_1 = 457
            KF_out_A_1 = 423
            KF_out_B_1 = 211
!       458. D0 + rho+  -->  D*+ + pi0
            i_channel_2 = 458
            KF_out_A_2 = 413
            KF_out_B_2 = 111
        else if( KF_D == -421 .AND. KF_M == -213 )then
!       459. Dbar0 + rho-  -->  D*bar0 + pi-
            i_channel_1 = 459
            KF_out_A_1 = -423
            KF_out_B_1 = -211
!       460. Dbar0 + rho-  -->  D*- + pi0
            i_channel_2 = 460
            KF_out_A_2 = -413
            KF_out_B_2 = 111
        else if( KF_D == 423 .AND. KF_M == 213 )then
!       461. D*0 + rho+  -->  D0 + pi+
            i_channel_1 = 461
            KF_out_A_1 = 421
            KF_out_B_1 = 211
!       462. D*0 + rho+  -->  D+ + pi0
            i_channel_2 = 462
            KF_out_A_2 = 411
            KF_out_B_2 = 111
        else if( KF_D == -423 .AND. KF_M == -213 )then
!       463. D*bar0 + rho-  -->  Dbar0 + pi-
            i_channel_1 = 463
            KF_out_A_1 = -421
            KF_out_B_1 = -211
!       464. D*bar0 + rho-  -->  D- + pi0
            i_channel_2 = 464
            KF_out_A_2 = -411
            KF_out_B_2 = 111
!       Something is wrong.
        else
            write(*,*) "No inel. channel is found in hadcas "       // &
                       "Dmeson2(), treated as elastic collision, "  // &
                       "KF_D, KF_M =", KF_D, KF_M
            return
        end if

        ratio_sig1 = 0D0
        ratio_sig2 = 0D0

        E_thresh_1 = PYMASS( KF_out_A_1 ) + PYMASS( KF_out_B_1 )
        E_thresh_2 = PYMASS( KF_out_A_2 ) + PYMASS( KF_out_B_2 )
        if( isinel( i_channel_1 ) == 1 .AND. E_AB > E_thresh_1 ) &
            ratio_sig1 = 0.5D0
        if( isinel( i_channel_2 ) == 1 .AND. E_AB > E_thresh_2 ) &
            ratio_sig2 = 0.5D0

        if( ratio_sig1 < 1D-15 .AND.ratio_sig2 < 1D-15 ) return

        ratio_sig = ratio_sig1 + ratio_sig2
        ratio1 = ratio_sig1 / ratio_sig
        if( PYR(1) <= ratio1 )then
            KF_out_A  = KF_out_A_1
            KF_out_B  = KF_out_B_1
            i_channel = i_channel_1
        else
            KF_out_A  = KF_out_A_2
            KF_out_B  = KF_out_B_2
            i_channel = i_channel_2
        end if

!       Order exchanging corresponding to that made in "DMeson_coll".
        if( i_od == -1 )then
            KF = KF_out_A
            KF_out_A = KF_out_B
            KF_out_B = KF
        end if

!       Feedback.
        lc(3) = KF_out_A
        lc(4) = KF_out_B
        lc(5) = i_channel
        tw  = rcsit
        ioo = 1


        return
        end



!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
        subroutine DN_coll( KF_A, KF_B, E_AB, lc, tw, ioo )
!       A part of "prod" to deal with D + p/n  --> ...
!       Single production channel: 465-488, total 32 reaction channels.
        IMPLICIT DOUBLE PRECISION(A-H, O-Z)
        IMPLICIT INTEGER(I-N)
        common/sa10_h/csnn,cspin,cskn,cspipi,cspsn,cspsm,rcsit,ifram, &
         iabsb,iabsm,i_sigma_AQM,csspn,csspm
        common/count_h/isinel(2000)
        integer, intent(in) :: KF_A, KF_B
        real(kind=8), intent(in) :: E_AB
        integer :: lc(6)


        ioo = 0

!       Makes the order as D + N.
        i_order = 1
        KF_D    = KF_A
        KF_N    = KF_B
!       Exchanges the order if first one is not D meson.
        if( ABS(KF_D) > 999 )then
            KF   = KF_D
            KF_D = KF_N
            KF_N = KF
            i_order = -1
        end if

!       465. D+  + p+    -->  D*+ + p+
        if( KF_D == 411 .AND. KF_N == 2212 )then
            i_channel = 465
            KF_out_A = 413
            KF_out_B = 2212
!       466. D+  + p-    -->  D*+ + p-
        else if( KF_D == 411 .AND. KF_N == -2212 )then
            i_channel = 466
            KF_out_A = 413
            KF_out_B = -2212
!       467. D+  + n     -->  D*+ + n
        else if( KF_D == 411 .AND. KF_N == 2112 )then
            i_channel = 467
            KF_out_A = 413
            KF_out_B = 2112
!       468. D+  + nbar  -->  D*+ + nbar
        else if( KF_D == 411 .AND. KF_N == -2112 )then
            i_channel = 468
            KF_out_A = 413
            KF_out_B = -2112
!       469. D-  + p+    -->  D*- + p+
        else if( KF_D == -411 .AND. KF_N == 2212 )then
            i_channel = 469
            KF_out_A = -413
            KF_out_B = 2212
!       470. D-  + p-    -->  D*- + p-
        else if( KF_D == -411 .AND. KF_N == -2212 )then
            i_channel = 470
            KF_out_A = -413
            KF_out_B = -2212
!       471. D-  + n     -->  D*- + n
        else if( KF_D == -411 .AND. KF_N == 2112 )then
            i_channel = 471
            KF_out_A = -413
            KF_out_B = 2112
!       472. D-  + nbar  -->  D*- + nbar
        else if( KF_D == -411 .AND. KF_N == -2112 )then
            i_channel = 472
            KF_out_A = -413
            KF_out_B = -2112
!       473. D*+ + p+    -->  D+  + p+
        else if( KF_D == 413 .AND. KF_N == 2212 )then
            i_channel = 473
            KF_out_A = 411
            KF_out_B = 2212
!       474. D*+ + p-    -->  D+  + p-
        else if( KF_D == 413 .AND. KF_N == -2212 )then
            i_channel = 474
            KF_out_A = 411
            KF_out_B = -2212
!       475. D*+ + n     -->  D+  + n
        else if( KF_D == 413 .AND. KF_N == 2112 )then
            i_channel = 475
            KF_out_A = 411
            KF_out_B = 2112
!       476. D*+ + nbar  -->  D+  + nbar
        else if( KF_D == 413 .AND. KF_N == -2112 )then
            i_channel = 476
            KF_out_A = 411
            KF_out_B = -2112
!       477. D*- + p+    -->  D-  + p+
        else if( KF_D == -413 .AND. KF_N == 2212 )then
            i_channel = 477
            KF_out_A = -411
            KF_out_B = 2212
!       478. D*- + p-    -->  D-  + p-
        else if( KF_D == -413 .AND. KF_N == -2212 )then
            i_channel = 478
            KF_out_A = -411
            KF_out_B = -2212
!       479. D*- + n     -->  D-  + n
        else if( KF_D == -413 .AND. KF_N == 2112 )then
            i_channel = 479
            KF_out_A = -411
            KF_out_B = 2112
!       480. D*- + nbar  -->  D-  + nbar
        else if( KF_D == -413 .AND. KF_N == -2112 )then
            i_channel = 480
            KF_out_A = -411
            KF_out_B = -2112
!       481. D0     + p+    -->  D*0 + p+
        else if( KF_D == 421 .AND. KF_N == 2212 )then
            i_channel = 481
            KF_out_A = 423
            KF_out_B = 2212
!       482. D0     + p-    -->  D*0 + p-
        else if( KF_D == 421 .AND. KF_N == -2212 )then
            i_channel = 482
            KF_out_A = 423
            KF_out_B = -2212
!       483. D0     + n     -->  D*0 + n
        else if( KF_D == 421 .AND. KF_N == 2112 )then
            i_channel = 483
            KF_out_A = 423
            KF_out_B = 2112
!       484. D0     + nbar  -->  D*0 + nbar
        else if( KF_D == 421 .AND. KF_N == -2112 )then
            i_channel = 484
            KF_out_A = 423
            KF_out_B = -2112
!       485. Dbar0  + p+    -->  D*bar0 + p+
        else if( KF_D == -421 .AND. KF_N == 2212 )then
            i_channel = 485
            KF_out_A = -423
            KF_out_B = 2212
!       486. Dbar0  + p-    -->  D*bar0 + p-
        else if( KF_D == -421 .AND. KF_N == -2212 )then
            i_channel = 486
            KF_out_A = -423
            KF_out_B = -2212
!       487. Dbar0  + n     -->  D*bar0 + n
        else if( KF_D == -421 .AND. KF_N == 2112 )then
            i_channel = 487
            KF_out_A = -423
            KF_out_B = 2112
!       488. Dbar0  + nbar  -->  D*bar0 + nbar
        else if( KF_D == -421 .AND. KF_N == -2112 )then
            i_channel = 488
            KF_out_A = -423
            KF_out_B = -2112
!       489. D*0    + p+    -->  D0 + p+
        else if( KF_D == 423 .AND. KF_N == 2212 )then
            i_channel = 489
            KF_out_A = 421
            KF_out_B = 2212
!       490. D*0    + p-    -->  D0 + p-
        else if( KF_D == 423 .AND. KF_N == -2212 )then
            i_channel = 490
            KF_out_A = 421
            KF_out_B = -2212
!       491. D*0    + n     -->  D0 + n
        else if( KF_D == 423 .AND. KF_N == 2112 )then
            i_channel = 491
            KF_out_A = 421
            KF_out_B = 2112
!       492. D*0    + nbar  -->  D0 + nbar
        else if( KF_D == 423 .AND. KF_N == -2112 )then
            i_channel = 492
            KF_out_A = 421
            KF_out_B = -2112
!       493. D*bar0 + p+    -->  Dbar0 + p+
        else if( KF_D == -423 .AND. KF_N == 2212 )then
            i_channel = 493
            KF_out_A = -421
            KF_out_B = 2212
!       494. D*bar0 + p-    -->  Dbar0 + p-
        else if( KF_D == -423 .AND. KF_N == -2212 )then
            i_channel = 494
            KF_out_A = -421
            KF_out_B = -2212
!       495. D*bar0 + n     -->  Dbar0 + n
        else if( KF_D == -423 .AND. KF_N == 2112 )then
            i_channel = 495
            KF_out_A = -421
            KF_out_B = 2112
!       496. D*bar0 + nbar  -->  Dbar0 + nbar
        else if( KF_D == -423 .AND. KF_N == -2112 )then
            i_channel = 496
            KF_out_A = -421
            KF_out_B = -2112
!       Something is wrong.
        else
            write(*,*) "No inel. channel is found in hadcas "        // &
                       "DN_coll(), treated as elastic collision, "  // &
                       "KF_D, KF_M =", KF_D, KF_N
            return
        end if

!       Inelastic channel switch.
        if( isinel( i_channel ) == 0 ) return
!       Threshold energy.
        E_thresh = PYMASS( KF_out_A ) + PYMASS( KF_out_B )
        if( E_AB <= E_thresh ) return

!       Order exchanging corresponding to that made in "DMeson_coll".
        if( i_order == -1 )then
            KF = KF_out_A
            KF_out_A = KF_out_B
            KF_out_B = KF
        end if

!       Feedback.
        lc(3) = KF_out_A
        lc(4) = KF_out_B
        lc(5) = i_channel
        tw  = rcsit
        ioo = 1


        return
        end



!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
        subroutine psi_pi_coll( kl, kl1, ss, lc, tw, ioo )
!!      A part of "prod" to deal with K + Delta --> ...
!       Finds production and fills up lc(i,3-5), tw(i).
!       Kaon + Delta channels are defined as 347-362.
!       kl, kl1: the KF code.
!       ss: the total energy (invariant mass) of two hadrons.
!       lc: collision list.
!       tw: the ratio of cross section of (special inela.)/tot.
!       ioo: flag of elastic (0) and inelastic (1) treatment.
        IMPLICIT DOUBLE PRECISION(A-H, O-Z)
        IMPLICIT INTEGER(I-N)
        common/sa10_h/csnn,cspin,cskn,cspipi,cspsn,cspsm,rcsit,ifram, &
         iabsb,iabsm,i_sigma_AQM,csspn,csspm
        common/sa20_h/t0,cspipiKK,dep,ddt,edipi,epin,ecsnn,ekn,ecspsn,ecspsm, &
         rnt,rnp,ecsspn,ecsspm
        common/iloval/ilo1,ilo2,ilo3,ilo4,ilo5,ilo6,ilo7,ilo8,ilo9
        common/count_h/isinel(2000)
        integer :: lc(6)


        ioo = 0

        if((kl == 443 .and. kl1 == 211) &
         .or. (kl == 211 .and. kl1 == 443))then
            if(iabsm == 0) return
            call jpsip1(ss,lc,tw,ioo,1)
            if(ioo == 0) return

        else if((kl == 443 .and. kl1 == 111) &
         .or. (kl == 111 .and. kl1 == 443))then
            if(iabsm == 0) return
            call jpsip0(ss,lc,tw,ioo,1)
            if(ioo == 0) return

        else if((kl == 443 .and. kl1 == -211) &
         .or. (kl == -211 .and. kl1 == 443))then
            if(iabsm == 0) return
            call jpsip2(ss,lc,tw,ioo,1)
            if(ioo == 0) return

        else if((kl == 100443 .and. kl1 == 211) &
         .or. (kl == 211 .and. kl1 == 100443))then
            if(iabsm == 0) return
            call jpsip1(ss,lc,tw,ioo,2)
            if(ioo == 0) return
            icp5=lc(5)
            if(icp5 <= 186)then
                lc(5)=icp5+14
            else
                lc(5)=icp5+192
            endif

        else if((kl == 100443 .and. kl1 == 111) &
         .or. (kl == 111 .and. kl1 == 100443))then
            if(iabsm == 0) return
            call jpsip0(ss,lc,tw,ioo,2)
            if(ioo == 0) return
            icp5=lc(5)
            if(icp5 <= 186)then
                lc(5)=icp5+14
            else
                lc(5)=icp5+192
            endif

        else if((kl == 100443 .and. kl1 == -211) &
         .or. (kl == -211 .and. kl1 == 100443))then
            if(iabsm == 0) return
            call jpsip2(ss,lc,tw,ioo,2)
            if(ioo == 0) return
            icp5=lc(5)
            if(icp5 <= 186)then
                lc(5)=icp5+14
            else
                lc(5)=icp5+192
            endif

        else
            return
        endif

        ioo = 1


        return
        end



!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
        subroutine psi_K_coll( kl, kl1, ss, lc, tw, ioo )
!!      A part of "prod" to deal with K + Delta --> ...
!       Finds production and fills up lc(i,3-5), tw(i).
!       Kaon + Delta channels are defined as 347-362.
!       kl, kl1: the KF code.
!       ss: the total energy (invariant mass) of two hadrons.
!       lc: collision list.
!       tw: the ratio of cross section of (special inela.)/tot.
!       ioo: flag of elastic (0) and inelastic (1) treatment.
        IMPLICIT DOUBLE PRECISION(A-H, O-Z)
        IMPLICIT INTEGER(I-N)
        common/sa10_h/csnn,cspin,cskn,cspipi,cspsn,cspsm,rcsit,ifram, &
         iabsb,iabsm,i_sigma_AQM,csspn,csspm
        common/sa20_h/t0,cspipiKK,dep,ddt,edipi,epin,ecsnn,ekn,ecspsn,ecspsm, &
         rnt,rnp,ecsspn,ecsspm
        common/iloval/ilo1,ilo2,ilo3,ilo4,ilo5,ilo6,ilo7,ilo8,ilo9
        common/count_h/isinel(2000)
        integer :: lc(6)


        kl  = kl
        kl1 = kl1
        ss  = ss

        ioo = 0
        lc(3) = 0
        lc(4) = 0
        lc(5) = 0
        tw  = 0D0

        ! Waiting...

        ! ioo = 1


        return
        end



!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
        subroutine psi_rho_coll( kl, kl1, ss, lc, tw, ioo )
!!      A part of "prod" to deal with K + Delta --> ...
!       Finds production and fills up lc(i,3-5), tw(i).
!       Kaon + Delta channels are defined as 347-362.
!       kl, kl1: the KF code.
!       ss: the total energy (invariant mass) of two hadrons.
!       lc: collision list.
!       tw: the ratio of cross section of (special inela.)/tot.
!       ioo: flag of elastic (0) and inelastic (1) treatment.
        IMPLICIT DOUBLE PRECISION(A-H, O-Z)
        IMPLICIT INTEGER(I-N)
        common/sa10_h/csnn,cspin,cskn,cspipi,cspsn,cspsm,rcsit,ifram, &
         iabsb,iabsm,i_sigma_AQM,csspn,csspm
        common/sa20_h/t0,cspipiKK,dep,ddt,edipi,epin,ecsnn,ekn,ecspsn,ecspsm, &
         rnt,rnp,ecsspn,ecsspm
        common/iloval/ilo1,ilo2,ilo3,ilo4,ilo5,ilo6,ilo7,ilo8,ilo9
        common/count_h/isinel(2000)
        integer :: lc(6)


        ioo = 0

        if((kl == 443 .and. kl1 == 213) &
         .or. (kl == 213 .and. kl1 == 443))then
            if(iabsm == 0) return
            call jpsir1(ss,lc,tw,ioo,1)
            if(ioo == 0) return

        else if((kl == 443 .and. kl1 == 113) &
         .or. (kl == 113 .and. kl1 == 443))then
            if(iabsm == 0) return
            call jpsir0(ss,lc,tw,ioo,1)
            if(ioo == 0) return

        else if((kl == 443 .and. kl1 == -213) &
         .or. (kl == -213 .and. kl1 == 443))then
            if(iabsm == 0) return
            call jpsir2(ss,lc,tw,ioo,1)
            if(ioo == 0) return

        else if((kl == 100443 .and. kl1 == 213) &
         .or. (kl == 213 .and. kl1 == 100443))then
            if(iabsm == 0) return
            call jpsir1(ss,lc,tw,ioo,2)
            if(ioo == 0) return
            icp5=lc(5)
            if(icp5 <= 186)then
                lc(5)=icp5+14
            else
                lc(5)=icp5+192
            endif

        else if((kl == 100443 .and. kl1 == 113) &
         .or. (kl == 113 .and. kl1 == 100443))then
            if(iabsm == 0) return
            call jpsir0(ss,lc,tw,ioo,2)
            if(ioo == 0) return
            icp5=lc(5)
            if(icp5 <= 186)then
                lc(5)=icp5+14
            else
                lc(5)=icp5+192
            endif

        else if((kl == 100443 .and. kl1 == -213) &
         .or. (kl == -213 .and. kl1 == 100443))then
            if(iabsm == 0) return
            call jpsir2(ss,lc,tw,ioo,2)
            if(ioo == 0) return
            icp5=lc(5)
            if(icp5 <= 186)then
                lc(5)=icp5+14
            else
                lc(5)=icp5+192
            endif

        else
            return
        endif

        ioo = 1


        return
        end



!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
        subroutine psi_N_coll( kl, kl1, ss, lc, tw, ioo )
!!      A part of "prod" to deal with K + Delta --> ...
!       Finds production and fills up lc(i,3-5), tw(i).
!       Kaon + Delta channels are defined as 347-362.
!       kl, kl1: the KF code.
!       ss: the total energy (invariant mass) of two hadrons.
!       lc: collision list.
!       tw: the ratio of cross section of (special inela.)/tot.
!       ioo: flag of elastic (0) and inelastic (1) treatment.
        IMPLICIT DOUBLE PRECISION(A-H, O-Z)
        IMPLICIT INTEGER(I-N)
        common/sa10_h/csnn,cspin,cskn,cspipi,cspsn,cspsm,rcsit,ifram, &
         iabsb,iabsm,i_sigma_AQM,csspn,csspm
        common/sa20_h/t0,cspipiKK,dep,ddt,edipi,epin,ecsnn,ekn,ecspsn,ecspsm, &
         rnt,rnp,ecsspn,ecsspm
        common/iloval/ilo1,ilo2,ilo3,ilo4,ilo5,ilo6,ilo7,ilo8,ilo9
        common/count_h/isinel(2000)
        integer :: lc(6)


        ioo = 0

        if(kl == 443 .and. kl1 == 2112)then
            if(iabsb == 0) return
            call jpsin(ss,lc,tw,ioo,1)
            if(ioo == 0) return

        else if(kl == 443 .and. kl1 == 2212)then
            if(iabsb == 0) return
            call jpsip(ss,lc,tw,ioo,1)
            if(ioo == 0) return

!       psi' interacts with baryon or meson
        else if(kl == 100443 .and. kl1 == 2112)then
            if(iabsb == 0) return
            call jpsin(ss,lc,tw,ioo,2)
!       argument '2' here refers to the psi' induced reaction
!       corresponding onse
            if(ioo == 0) return
            icp5=lc(5)
            if(icp5 <= 186)then
                lc(5)=icp5+14
            else
                lc(5)=icp5+192
            endif
!       14 and 192 are the distance (in order number) of inelastic reaction
!        between J/psi induced reaction and psi, induced corresponding
!        reaction

        else if(kl == 100443 .and. kl1 == 2212)then
            if(iabsb == 0) return
            call jpsip(ss,lc,tw,ioo,2)
            if(ioo == 0) return
            icp5=lc(5)
            if(icp5 <= 186)then
                lc(5)=icp5+14
            else
                lc(5)=icp5+192
            endif

        else
            return
        endif

        ioo = 1


        return
        end



!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
        subroutine jpsin(ss,lc,tw,ioo,ii)
!!      A part of "prod" to deal with J/psi (psi') + N to ...
!       ii = 1 for J/psi, ii = 2 for psi'
        IMPLICIT DOUBLE PRECISION(A-H, O-Z)
        IMPLICIT INTEGER(I-N)
        INTEGER PYCOMP
        COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4)
        COMMON/PYCIDAT2/KFMAXT,NONT2,PARAM(100)
        SAVE /PYCIDAT2/
        common/sa10_h/csnn,cspin,cskn,cspipi,cspsn,cspsm,rcsit,ifram, &
         iabsb,iabsm,i_sigma_AQM,csspn,csspm
        common/count_h/isinel(2000)
        common/iloval/ilo1,ilo2,ilo3,ilo4,ilo5,ilo6,ilo7,ilo8,ilo9
        integer :: lc(6)


        if(isinel(179) == 0)then
            sigma1=0.
            goto 212
        endif
        the=PMAS(PYCOMP(4122),1)+PMAS(PYCOMP(411),1)
!       the: threshold energy of a reaction (squart root of s)
        if(ss <= the)then
            sigma1=0.
            goto 212
        endif
        sigma1=cspsn
!       cross section of J/psi + N (fm^2)
        if(ii == 2) sigma1 = csspn
!       cross section of psi' + N (fm^2)
212     if(isinel(180) == 0)then
            sigma2=0.
            goto 213
        endif
        the=PMAS(PYCOMP(4212),1)+PMAS(PYCOMP(411),1)
        if(ss <= the)then
            sigma2=0.
            goto 213
        endif
        sigma2=cspsn
        if(ii == 2) sigma2 = csspn
213     if(isinel(181) == 0)then
            sigma3=0.
            goto 214
        endif
        the=PMAS(PYCOMP(4112),1)+PMAS(PYCOMP(421),1)
        if(ss <= the)then
            sigma3=0.
            goto 214
        endif
        sigma3 = cspsn
        if(ii == 2) sigma3 = csspn
214     if(sigma1 < 1D-16 .and. sigma2 < 1D-16 .and. &
          sigma3 < 1D-16) return
        sigma12=sigma1+sigma2
        sigma13=sigma12+sigma3
        s1=sigma1/sigma13
        s2=sigma12/sigma13
        rlus=PYR(1)
        if(rlus <= s1)then
            ik1=4122
            ik2=-411
            ic=179
!       J/psi (psi') + n to Lamda_c+ + Dba
        elseif(rlus > s1 .and. rlus <= s2)then
            ik1=4212
            ik2=-411
            ic=180
!       J/psi (psi') + n to sigmac+ + Dba
        else
            ik1=4112
            ik2=-421
            ic=181
!       J/psi (psi') + n to sigmac0 + D0ba
        endif
        lc(3)=ik1
        lc(4)=ik2
        lc(5)=ic
        tw=sigma13*rcsit/cspsn
        if(ii == 2) tw=sigma13*rcsit/csspn
        ioo=1


        return
        end



!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
        subroutine jpsip(ss,lc,tw,ioo,ii)
!!      A part of "prod" to deal with J/psi (psi') + p to ...
        IMPLICIT DOUBLE PRECISION(A-H, O-Z)
        IMPLICIT INTEGER(I-N)
        INTEGER PYCOMP
        COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4)
        COMMON/PYCIDAT2/KFMAXT,NONT2,PARAM(100)
        SAVE /PYCIDAT2/
        common/sa10_h/csnn,cspin,cskn,cspipi,cspsn,cspsm,rcsit,ifram, &
         iabsb,iabsm,i_sigma_AQM,csspn,csspm
        common/count_h/isinel(2000)
        common/iloval/ilo1,ilo2,ilo3,ilo4,ilo5,ilo6,ilo7,ilo8,ilo9
        integer :: lc(6)


        if(isinel(182) == 0)then
        sigma1=0.
        goto 212
        endif
        the=PMAS(PYCOMP(4122),1)+PMAS(PYCOMP(421),1)
!       the: threshold energy of a reaction (squart root of s)
        if(ss <= the)then
        sigma1=0.
        goto 212
        endif
        sigma1=cspsn
        if(ii == 2) sigma1=csspn
212     if(isinel(183) == 0)then
        sigma2=0.
        goto 213
        endif
        the=PMAS(PYCOMP(4212),1)+PMAS(PYCOMP(421),1)
        if(ss <= the)then
        sigma2=0.
        goto 213
        endif
        sigma2=cspsn
        if(ii == 2) sigma2=csspn
213     if(isinel(184) == 0)then
        sigma3=0.
        goto 214
        endif
        the=PMAS(PYCOMP(4222),1)+PMAS(PYCOMP(411),1)
        if(ss <= the)then
        sigma3=0.
        goto 214
        endif
        sigma3=cspsn
        if(ii == 2) sigma3=csspn
214     if(sigma1 < 1.e-16 .and. sigma2 < 1.e-16 .and. &
          sigma3 < 1.e-16) return
        sigma12=sigma1+sigma2
        sigma13=sigma12+sigma3
        s1=sigma1/sigma13
        s2=sigma12/sigma13
        rlus=PYR(1)
        if(rlus <= s1)then
        ik1=4122
        ik2=-421
        ic=182
!       J/psi (psi') + p to Lamda_c+ + D0ba
        elseif(rlus > s1 .and. rlus <= s2)then
        ik1=4212
        ik2=-421
        ic=183
!       J/psi (psi') + p to sigmac+  + D0ba
        else
        ik1=4222
        ik2=-411
        ic=184
!       J/psi (psi') + p to sigmac++ + Dba
        endif
        lc(3)=ik1
        lc(4)=ik2
        lc(5)=ic
        tw=sigma13*rcsit/cspsn
        if(ii == 2) tw=sigma13*rcsit/csspn
        ioo=1


        return
        end



!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
        subroutine jpsip1(ss,lc,tw,ioo,ii)
!       a part of 'prod' to deal with J/psi (psi') + pion+ to ...
        IMPLICIT DOUBLE PRECISION(A-H, O-Z)
        IMPLICIT INTEGER(I-N)
        INTEGER PYCOMP
        COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4)
        COMMON/PYCIDAT2/KFMAXT,NONT2,PARAM(100)
        SAVE /PYCIDAT2/
        common/sa10_h/csnn,cspin,cskn,cspipi,cspsn,cspsm,rcsit,ifram, &
         iabsb,iabsm,i_sigma_AQM,csspn,csspm
        common/count_h/isinel(2000)
        common/iloval/ilo1,ilo2,ilo3,ilo4,ilo5,ilo6,ilo7,ilo8,ilo9
        integer :: lc(6)


        ioo = 0
        if(isinel(185) == 0) return
        the=PMAS(PYCOMP(411),1)+PMAS(PYCOMP(423),1)
        if(ss <= the) return
!       J/psi + pion+ to D + D*0ba
        lc(3)=411
        lc(4)=-423
        lc(5)=185
        tw=rcsit
        ioo=1
        jj=ii


        return
        end



!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
        subroutine jpsip0(ss,lc,tw,ioo,ii)
!       a part of 'prod' to deal with J/psi (psi') + pion0 to ...
        IMPLICIT DOUBLE PRECISION(A-H, O-Z)
        IMPLICIT INTEGER(I-N)
        INTEGER PYCOMP
        COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4)
        COMMON/PYCIDAT2/KFMAXT,NONT2,PARAM(100)
        SAVE /PYCIDAT2/
        common/sa10_h/csnn,cspin,cskn,cspipi,cspsn,cspsm,rcsit,ifram, &
         iabsb,iabsm,i_sigma_AQM,csspn,csspm
        common/count_h/isinel(2000)
        common/iloval/ilo1,ilo2,ilo3,ilo4,ilo5,ilo6,ilo7,ilo8,ilo9
        integer :: lc(6)


        ioo = 0
        if(isinel(186) == 0)then
        sigma1=0.
        goto 212
        endif
        the=PMAS(PYCOMP(421),1)+PMAS(PYCOMP(423),1)
!       the: threshold energy of a reaction (squart root of s)
        if(ss <= the)then
        sigma1=0.
        goto 212
        endif
        sigma1=cspsm
!       cross section of J/psi + meson (fm^2)
        if(ii == 2) sigma1=csspm
!       cross section of psi' + meson (fm^2)
212     if(isinel(187) == 0)then
        sigma2=0.
        goto 213
        endif
        the=PMAS(PYCOMP(411),1)+PMAS(PYCOMP(413),1)
        if(ss <= the)then
        sigma2=0.
        goto 213
        endif
        sigma2=cspsm
        if(ii == 2) sigma2=csspm
213     if(sigma1 < 1.e-16 .and. sigma2 < 1.e-16) return
        sigma12=sigma1+sigma2
        s1=sigma1/sigma12
        rlus=PYR(1)
        if(rlus <= s1)then
        ik1=421
        ik2=-423
        ic=186
!       J/psi (psi') + pion0 to D0 + D*0ba
        else
        ik1=411
        ik2=-413
        ic=187
!       J/psi (psi') + pion0 to D + D*ba
        endif
        lc(3)=ik1
        lc(4)=ik2
        lc(5)=ic
        tw=sigma12*rcsit/cspsm
        if(ii == 2) tw=sigma12*rcsit/csspm
        ioo=1


        return
        end



!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
        subroutine jpsip2(ss,lc,tw,ioo,ii)
!       a part of 'prod' to deal with J/psi (psi') + pion- to ...
        IMPLICIT DOUBLE PRECISION(A-H, O-Z)
        IMPLICIT INTEGER(I-N)
        INTEGER PYCOMP
        COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4)
        COMMON/PYCIDAT2/KFMAXT,NONT2,PARAM(100)
        SAVE /PYCIDAT2/
        common/sa10_h/csnn,cspin,cskn,cspipi,cspsn,cspsm,rcsit,ifram, &
         iabsb,iabsm,i_sigma_AQM,csspn,csspm
        common/count_h/isinel(2000)
        common/iloval/ilo1,ilo2,ilo3,ilo4,ilo5,ilo6,ilo7,ilo8,ilo9
        integer :: lc(6)


        ioo = 0
        if(isinel(188) == 0) return
        the=PMAS(PYCOMP(421),1)+PMAS(PYCOMP(413),1)
        if(ss <= the) return
!       J/psi (psi') + pion- to D0 + D*ba
        lc(3)=421
        lc(4)=-413
        lc(5)=188
        tw=rcsit
        ioo=1
        jj=ii


        return
        end



!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
        subroutine jpsir1(ss,lc,tw,ioo,ii)
!       a part of 'prod' to deal with J/psi (psi') + rho+ to ...
        IMPLICIT DOUBLE PRECISION(A-H, O-Z)
        IMPLICIT INTEGER(I-N)
        INTEGER PYCOMP
        COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4)
        COMMON/PYCIDAT2/KFMAXT,NONT2,PARAM(100)
        SAVE /PYCIDAT2/
        common/sa10_h/csnn,cspin,cskn,cspipi,cspsn,cspsm,rcsit,ifram, &
         iabsb,iabsm,i_sigma_AQM,csspn,csspm
        common/count_h/isinel(2000)
        common/iloval/ilo1,ilo2,ilo3,ilo4,ilo5,ilo6,ilo7,ilo8,ilo9
        integer :: lc(6)


        ioo = 0
        if(isinel(189) == 0) return
        the=PMAS(PYCOMP(411),1)+PMAS(PYCOMP(421),1)
        if(ss <= the) return
!       J/psi (psi,) + rho+ to D + D0ba
        lc(3)=411
        lc(4)=-421
        lc(5)=189
        tw=rcsit
        ioo=1
        jj=ii


        return
        end



!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
        subroutine jpsir0(ss,lc,tw,ioo,ii)
!       a part of 'prod' to deal with J/psi (psi') + rho0 to ...
        IMPLICIT DOUBLE PRECISION(A-H, O-Z)
        IMPLICIT INTEGER(I-N)
        INTEGER PYCOMP
        COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4)
        COMMON/PYCIDAT2/KFMAXT,NONT2,PARAM(100)
        SAVE /PYCIDAT2/
        common/sa10_h/csnn,cspin,cskn,cspipi,cspsn,cspsm,rcsit,ifram, &
         iabsb,iabsm,i_sigma_AQM,csspn,csspm
        common/count_h/isinel(2000)
        common/iloval/ilo1,ilo2,ilo3,ilo4,ilo5,ilo6,ilo7,ilo8,ilo9
        integer :: lc(6)


        ioo = 0
        if(isinel(190) == 0)then
        sigma1=0.
        goto 212
        endif
        the=PMAS(PYCOMP(421),1)*2.
!       the: threshold energy of a reaction (squart root of s)
        if(ss <= the)then
        sigma1=0.
        goto 212
        endif
        sigma1=cspsm
        if(ii == 2) sigma1=csspm
212     if(isinel(191) == 0)then
        sigma2=0.
        goto 213
        endif
        the=PMAS(PYCOMP(411),1)*2.
        if(ss <= the)then
        sigma2=0.
        goto 213
        endif
        sigma2=cspsm
        if(ii == 2) sigma2=csspm
213     if(sigma1 < 1.e-16 .and. sigma2 < 1.e-16) return
        sigma12=sigma1+sigma2
        s1=sigma1/sigma12
        rlus=PYR(1)
        if(rlus <= s1)then
        ik1=421
        ik2=-421
        ic=190
!       J/psi (psi') + rho0 to D0 + D0ba
        else
        ik1=411
        ik2=-411
        ic=191
!       J/psi (psi') + rho0 to D + Dba
        endif
        lc(3)=ik1
        lc(4)=ik2
        lc(5)=ic
        tw=2.*sigma12*rcsit/cspsm
        if(ii == 2) tw=2.*sigma12*rcsit/csspm
!       at the case of rho0, cross section enlarges a factor 2 to
!        consider the effect of omega
        ioo=1


        return
        end



!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
        subroutine jpsir2(ss,lc,tw,ioo,ii)
!       a part of 'prod' to deal with J/psi (psi') + rho- to ...
        IMPLICIT DOUBLE PRECISION(A-H, O-Z)
        IMPLICIT INTEGER(I-N)
        INTEGER PYCOMP
        COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4)
        COMMON/PYCIDAT2/KFMAXT,NONT2,PARAM(100)
        SAVE /PYCIDAT2/
        common/sa10_h/csnn,cspin,cskn,cspipi,cspsn,cspsm,rcsit,ifram, &
         iabsb,iabsm,i_sigma_AQM,csspn,csspm
        common/count_h/isinel(2000)
        common/iloval/ilo1,ilo2,ilo3,ilo4,ilo5,ilo6,ilo7,ilo8,ilo9
        integer :: lc(6)


        ioo = 0
        if(isinel(192) == 0) return
        the=PMAS(PYCOMP(421),1)+PMAS(PYCOMP(411),1)
        if(ss <= the) return
!       J/psi + rho- to D0 + Dba
        lc(3)=421
        lc(4)=-411
        lc(5)=192
        tw=rcsit
        ioo=1
        jj=ii


        return
        end



!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
        subroutine srev( kl,kl1,lc3,lc4,ss,ilo,fac,xii1,xii2,xsi1,xsi2, &
                         xif1,xif2,xsf1,xsf2,pauli )
!!      Calculates the reverse reaction factor by the detailed balance.
!!      kl,  kl1: KF codes of two particles in initial state
!!      lc3, lc4: KF codes of two particles in final state
!       ss: CM energy
!       ilo: = 0, the CM energy is lower than threshold energy
!            = 1, succeeded.
!       xii1, xii2: the isospin of of two particles in initial state
!       xsi1, xsi2: the spin of two particles in initial state
!       xif1, xif2: the isospin of of two particles in final state
!       xsf1, xsf2: the spin of two particles in final state
!       paul1: =1 if two particles are different in final state
!              =0.5 if identical two particles in final state
        IMPLICIT DOUBLE PRECISION(A-H, O-Z)
        IMPLICIT INTEGER(I-N)
        real*4 xii1,xii2,xsi1,xsi2,xif1,xif2,xsf1,xsf2,pauli


        x_isospin_initial_1 = xii1
        x_isospin_initial_2 = xii2
        x_isospin_final_1 = xif1
        x_isospin_final_2 = xif2
        am1  = PYMASS(kl)
        am2  = PYMASS(kl1)
        am3  = PYMASS(lc3)
        am4  = PYMASS(lc4)
        am12 = am1*am1
        am22 = am2*am2
        am32 = am3*am3
        am42 = am4*am4
        ss2  = ss*ss
        ss4  = ss2*ss2
        ilo  = 1

        if( ss < (am3 + am4) )then
            ilo = 0
            fac = 0D0
        else
            pfp = ss4 - 2D0 * ss2 * (am32 + am42) + (am32 - am42)*(am32 - am42)
            pfp = pfp / 4D0 / ss2
            if( pfp < 0D0 ) pfp = 1D-10
!           pfp = SQRT(pfp) / 2D0 / ss
            pip = ss4 - 2D0 * ss2 * (am12 + am22) + (am12 - am22)*(am12 - am22)
            pip = pip / 4D0 / ss2
            if( pip < 0D0 ) pip = 1D-10
!           pip = SQRT(pip) / 2D0 / ss
!           phase = pauli * (2D0*xif1 + 1D0) * (2D0*xif2 + 1D0) &
!                         * (2D0*xsf1 + 1D0) * (2D0*xsf2 + 1D0) &
!                         / (2D0*xii1 + 1D0) * (2D0*xii2 + 1D0) &
!                         / (2D0*xsi1 + 1D0) * (2D0*xsi2 + 1D0)
            phase = pauli * (2D0*xsf1 + 1D0) * (2D0*xsf2 + 1D0) &
                          / (2D0*xsi1 + 1D0) / (2D0*xsi2 + 1D0)
            fac = phase * pfp / pip
        end if


        return
        end



!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
        subroutine coelas_h(ic,jc,eij,pi,pj)
!!      Performs elastic scattering.
        IMPLICIT DOUBLE PRECISION(A-H, O-Z)
        IMPLICIT INTEGER(I-N)
        PARAMETER (KSZJ=300000)
        common/sa1_h/nsa,non1,ksa(kszj,5),psa(kszj,5),vsa(kszj,5)
        integer, intent(in) :: ic, jc
        real(kind=8), intent(in) :: eij
        dimension pi(4),pj(4)


        iic = ksa(ic,2)
        jjc = ksa(jc,2)
        d   = 3.65D0 * ( eij - PYMASS(iic) - PYMASS(jjc) )
        if( d < 1D-10 ) return
        ! Changed from 0.2 to 0.5 on 100111.
        ! pt = 0.2D0
        pt = 0.5D0
        A  = MIN( 10.3D0, 1.D0 / ( 1.12D0 * pt ) / ( 1.12D0 * pt ) )
        d6 = d**6
        B  = d6 * A / ( 1D0 + d6 )
        if( B < 1D-20 ) B = 1D-20

        ! Approximation
        ! pt = 0.5D0
        ! A  = MIN( 10.3D0, 1.D0 / ( 1.12D0 * pt ) / ( 1.12D0 * pt ) )
        ! B = A

        pm2 = pi(1)**2 + pi(2)**2 + pi(3)**2
        pm  = SQRT(pm2)
        t0  = - 4D0 * pm2
        if( ABS(t0) < 1D-20 )then
            cctas = 1D0
!       maximum of cos(theta_s) = 1
            goto 100
        end if
        if( ABS( B*t0 ) < 0.0001D0 )then
            ! abt = EXP( B*t0 ), B*t0 < 0
            abt = 1D0
!       else if( B*t0 < -50D0 )then
!           abt = 0D0
        else
            abt = EXP( MAX( -7.0D2, B*t0 ) )
        end if
        cc = PYR(1)
        tt1 = LOG( cc + ( 1D0 - cc ) * abt )
        if( ABS(tt1) < 1D-30 .AND. B <= 1D-20 )then
            cctas = 1D0
            goto 100
        end if
        tt = tt1 / B
        if( ABS(tt) < 1D-20 )then
            cctas = 1D0
            goto 100
        end if
        cctas = 1D0 - tt * 2D0 / t0
        if( ABS(cctas) > 1D0 )then
            cctas = SIGN( 1D0, cctas )
        end if
100     continue
        sctas = SQRT( 1D0 - cctas**2 )
        fis   = 2D0 * 3.141592653589793D0 * PYR(1)
        cfis  = COS(fis)
        sfis  = SIN(fis)
        call rotate_h( cctas, sctas, cfis, sfis, pm, pi, pj )


        return
        end



!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
        subroutine rotate_h(cctas,sctas,cfis,sfis,pp3,pi,pj)
!!      Performs the rotation after elastic scattering.
!       pi,pj: input, four momentum of colliding pair before scattering
!              output,four momentum of scattered particles after rotation
!       pp3: momentum modulus of pi or pj, both are equal in their cms,
!        after scattering
!       cctas,sctas,cfis,sfis: direction cosines of momentum of one of
!        scattered particle relative to the momentum
!        of corresponding particle before scattering.
        IMPLICIT DOUBLE PRECISION(A-H, O-Z)
        IMPLICIT INTEGER(I-N)
        dimension pi(4),pj(4)


        fi1   = PYANGL( pi(1), pi(2) )
        cta1  = PYANGL( pi(3), SQRT( pi(1)**2 + pi(2)**2 ) )
        cfi1  = COS(fi1)
        sfi1  = SIN(fi1)
        ccta1 = COS(cta1)
        scta1 = SIN(cta1)
        pi(1) = cfi1 * ( ccta1*sctas*cfis + scta1*cctas ) - sfi1*sctas*sfis
        pi(2) = sfi1 * ( ccta1*sctas*cfis + scta1*cctas ) + cfi1*sctas*sfis
        pi(3) = ccta1*cctas - scta1*sctas*cfis
        pi(1) = pp3 * pi(1)
        pi(2) = pp3 * pi(2)
        pi(3) = pp3 * pi(3)
        do i=1,3,1
            pj(i) = 0D0 - pi(i)
        end do


        return
        end



!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
        subroutine updple_h(ic,jc,b,pi,pj)
!!      Updates the particle list after elastic scattering.
        IMPLICIT DOUBLE PRECISION(A-H, O-Z)
        IMPLICIT INTEGER(I-N)
        PARAMETER (KSZJ=300000)
        common/sa1_h/nsa,non1,ksa(kszj,5),psa(kszj,5),vsa(kszj,5)
        common/sa8_h/tau(kszj),ishp(kszj)
        common/sa19_h/coor(3)
        common/sa20_h/t0,cspipiKK,dep,ddt,edipi,epin,ecsnn,ekn,ecspsn,ecspsm, &
         rnt,rnp,ecsspn,ecsspm
         integer, intent(in) :: ic, jc
         real(kind=8), intent(in) :: b(3)
        dimension pi(4), pj(4)


        ilo = 1
!       ilo=1 for the inverse Lorentz transformation
        call lorntz(ilo,b,pi,pj)
        do i=1,4,1
            psa(ic,i) = pi(i)
            psa(jc,i) = pj(i)
        end do
        ! ic
        ksa(ic,1) = 152
        ksa(ic,3) = ic
        ksa(ic,4) = 0
        ksa(ic,5) = 0
        ! jc
        ksa(jc,1) = 152
        ksa(jc,3) = jc
        ksa(jc,4) = 0
        ksa(jc,5) = 0


        return
        end



!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
        subroutine updatl_h( ic, jc, icp, nsa0 )
!!      Updates the collision time list.
        IMPLICIT DOUBLE PRECISION(A-H, O-Z)
        IMPLICIT INTEGER(I-N)
        LOGICAL INTO_HRS
        PARAMETER (KSZJ=300000,NSIZE=750000)
        common/sa1_h/nsa,non1,ksa(kszj,5),psa(kszj,5),vsa(kszj,5)
        common/sa8_h/tau(kszj),ishp(kszj)
        common/sa9_h/kfmax,kfaco(100),numb(100)
        common/sa20_h/t0,cspipiKK,dep,ddt,edipi,epin,ecsnn,ekn,ecspsn,ecspsm, &
         rnt,rnp,ecsspn,ecsspm
        common/ctllist_h/nctl,noinel(2000),nctl0,noel
        common/ctllist_t/ lc(nsize,6), tc(nsize), tw(nsize)
        integer, intent(in) :: ic, jc, icp
        integer :: nsa0
        integer :: l_coll(6)
        real(kind=8) :: t_coll, t_coll_min
        logical :: succeed


!       Throws away the currently scattered pair.
        nctl = nctl - 1
        do k1 = icp, nctl, 1
            lc( k1, 1 ) = lc( k1+1, 1 )
            lc( k1, 2 ) = lc( k1+1, 2 )
            lc( k1, 3 ) = lc( k1+1, 3 )
            lc( k1, 4 ) = lc( k1+1, 4 )
            lc( k1, 5 ) = lc( k1+1, 5 )
            lc( k1, 6 ) = lc( k1+1, 6 )
            tc( k1 )    = tc( k1+1 )
            tw( k1 )    = tw( k1+1 )
        end do

!       Loops over ic,jc (new) and old partons (i.e. constructs colli. pair
!        by partons, one of which is ic/jc and another one is in parton list).

        ! Time resolution.
        dddt = ddt
        ! The collision pair counter (+1 avoids 0 nctl).
        nctl = nctl + 1
        do ii=1,2,1
            if( ii == 1 ) i = ic
            if( ii == 2 ) i = jc
            KF = ksa(i,2)
            if( .NOT.INTO_HRS(KF) )then
                ishp(i) = 0
                cycle
            end if
            ! Successful flag.
            succeed = .false.
            ! A number large enough to determine the minumum time.
            t_coll_min = 1D30
            ixc = 0
            jxc = 0
            loop_j: do j = 1, nsa0, 1
                if( ishp(j) == 0 ) cycle
                ! Avoids two particles colliding immediately after a collision.
                if( j == ic .OR. j == jc ) cycle
                call rsfilt_h( i, j, iflag )
                if( iflag == 0 ) cycle
                call coij_h( i, j, i_fail, l_coll, t_coll )
                if( i_fail == 1 ) cycle
                ! Imposes the time resolution constraint.
                if( t_coll < 1D-10 ) cycle
                do j1 = 1, nctl-1, 1
                    if( ABS( tc(j1) - t_coll ) < dddt ) cycle loop_j
                end do
                ! Chooses the smallest time for 'i'-cycle.
                if( t_coll < t_coll_min )then
                    lc(nctl,1) = l_coll(1)
                    lc(nctl,2) = l_coll(2)
                    lc(nctl,3) = l_coll(3)
                    lc(nctl,4) = l_coll(4)
                    lc(nctl,5) = l_coll(5)
                    lc(nctl,6) = l_coll(6)
                    tc(nctl)   = t_coll
                    tw(nctl)   = 0D0
                    t_coll_min = t_coll
                    ixc = l_coll(1)
                    jxc = l_coll(2)
                end if
                succeed = .true.
            end do loop_j
            ! Keeps the one with the smallest time from pairs including i or j.
            if( succeed )then
                n_jump_out = 0
                j1 = 1
                do while(.true.)
                    if( j1 > nctl-1 ) exit
                    iic = lc(j1,1)
                    jjc = lc(j1,2)
                    if(       ixc /= iic .AND. ixc /= jjc &
                        .AND. jxc /= iic .AND. jxc /= jjc )then
                        j1  = j1 + 1
                        cycle
                    end if
                    ttc = tc(j1)
                    ! Thows away the pair with larger time.
                    if( ttc > t_coll_min )then
                        k_begin = j1
                        n_jump_out = 2
                    else
                        k_begin = nctl
                        n_jump_out = 2
                    end if
                    nctl = nctl - 1
                    do k1 = k_begin, nctl, 1
                        lc( k1, 1 ) = lc( k1+1, 1 )
                        lc( k1, 2 ) = lc( k1+1, 2 )
                        lc( k1, 3 ) = lc( k1+1, 3 )
                        lc( k1, 4 ) = lc( k1+1, 4 )
                        lc( k1, 5 ) = lc( k1+1, 5 )
                        lc( k1, 6 ) = lc( k1+1, 6 )
                        tc( k1 )    = tc( k1+1 )
                        tw( k1 )    = tw( k1+1 )
                    end do
                    if( n_jump_out == 2 ) exit
                end do
                ! For the next time finding.
                nctl = nctl + 1
            end if
        end do
        ! Deducts 1 because the counter begins with +1 not 0.
        nctl = nctl - 1
        nsa0 = nsa


        return
        end



!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
        subroutine rsfilt_h( iA, iB, iflag )
!!      Plays the role of first range filter and guarantee the collision list
!!       is composed according to the entrance channels of considered
!!       inelastic reactions.
!!      Subroutine intdis plays the role of second range filter
!!      Collision pairs not interested can not filter through both of rsfilt
!!       and intdis.
        IMPLICIT DOUBLE PRECISION(A-H, O-Z)
        IMPLICIT INTEGER(I-N)
        PARAMETER (KSZJ=300000)
        common/sa1_h/nsa,non1,ksa(kszj,5),psa(kszj,5),vsa(kszj,5)
        common/sa8_h/tau(kszj),ishp(kszj)
        common/sa10_h/csnn,cspin,cskn,cspipi,cspsn,cspsm,rcsit,ifram, &
         iabsb,iabsm,i_sigma_AQM,csspn,csspm


        iflag = 1
        kA    = ksa(iA,2)
        kB    = ksa(iB,2)
        if( iA == iB )then
            iflag = 0
            return
        end if

!       Considers channels that are not well defined and treats them as elastic.
        if( i_sigma_AQM == 2 .OR. i_sigma_AQM == 4 )then
            return
        end if

        ! pi+ + X
        if(      kA ==  211 )then
            ! + pi-/pi0
            if(          kB  == -211  .OR.     kB  ==  111    )then
            ! + p/pbar/n/nbar
            else if( ABS(kB) ==  2212 .OR. ABS(kB) ==  2112   )then
            ! + Delta+/Deltabar-/Delta0/Deltabar0/Deltabar--/Delta-
            else if( ABS(kB) ==  2214 .OR. ABS(kB) ==  2114   &
                .OR.     kB  == -2224 .OR.     kB  ==  1114   )then
            ! + Lambda0/Lambdabar0/Sigma0/Sigmabar0/Sigmabar-/Sigma-
            else if( ABS(kB) ==  3122 .OR. ABS(kB) ==  3212   &
                .OR.     kB  == -3222 .OR.     kB  ==  3112   )then
            ! + Xi-/Xibar+/Xi0/Xibar0
            else if( ABS(kB) ==  3312 .OR. ABS(kB) ==  3322   )then
            ! + Omega-/Omegabar+
            else if( ABS(kB) ==  3334 )then
            ! + D+/D-/D*+/D*-/D0/Dbar0/D*0/D*bar0
            else if( ABS(kB) ==  411  .OR. ABS(kB) ==  413    &
                .OR. ABS(kB) ==  421  .OR. ABS(kB) ==  423    )then
            ! + J/psi / psi'
            else if(     kB  ==  443  .OR.     kB  ==  100443 )then
            ! Not defined.
            else
                iflag = 0
            end if
        ! h + pi+
        else if( kB ==  211 )then
            ! + pi-/pi0
            if(          kA  == -211  .OR.     kA  ==  111    )then
            ! + p/pbar/n/nbar
            else if( ABS(kA) ==  2212 .OR. ABS(kA) ==  2112   )then
            ! + Delta+/Deltabar-/Delta0/Deltabar0/Deltabar--/Delta-
            else if( ABS(kA) ==  2214 .OR. ABS(kA) ==  2114   &
                .OR.     kA  == -2224 .OR.     kA  ==  1114   )then
            ! + Lambda0/Lambdabar0/Sigma0/Sigmabar0/Sigmabar-/Sigma-
            else if( ABS(kA) ==  3122 .OR. ABS(kA) ==  3212   &
                .OR.     kA  == -3222 .OR.     kA  ==  3112   )then
            ! + Xi-/Xibar+/Xi0/Xibar0
            else if( ABS(kA) ==  3312 .OR. ABS(kA) ==  3322   )then
            ! + Omega-/Omegabar+
            else if( ABS(kA) ==  3334 )then
            ! + D+/D-/D*+/D*-/D0/Dbar0/D*0/D*bar0
            else if( ABS(kA) ==  411  .OR. ABS(kA) ==  413    &
                .OR. ABS(kA) ==  421  .OR. ABS(kA) ==  423    )then
            ! + J/psi / psi'
            else if(     kA  ==  443  .OR.     kA  ==  100443 )then
            ! Not defined.
            else
                iflag = 0
            end if

        ! pi- + h
        else if( kA == -211 )then
            ! + pi+/pi0
            if(          kB  ==  211  .OR.     kB  ==  111    )then
            ! + p/pbar/n/nbar
            else if( ABS(kB) ==  2212 .OR. ABS(kB) ==  2112   )then
            ! + Delta+/Deltabar-/Delta0/Deltabar0/Delta++/Deltabar+
            else if( ABS(kB) ==  2214 .OR. ABS(kB) ==  2114   &
                .OR.     kB  ==  2224 .OR.     kB  == -1114   )then
            ! + Lambda0/Lambdabar0/Sigma0/Sigmabar0/Sigma+/Sigmabar+
            else if( ABS(kB) ==  3122 .OR. ABS(kB) ==  3212   &
                .OR.     kB  ==  3222 .OR.     kB  == -3112   )then
            ! + Xi-/Xibar+/Xi0/Xibar0
            else if( ABS(kB) ==  3312 .OR. ABS(kB) == 3322   )then
            ! + Omega-/Omegabar+
            else if( ABS(kB) ==  3334 )then
            ! + D+/D-/D*+/D*-/D0/Dbar0/D*0/D*bar0
            else if( ABS(kB) ==  411  .OR. ABS(kB) == 413    &
                .OR. ABS(kB) ==  421  .OR. ABS(kB) == 423    )then
            ! + J/psi / psi'
            else if(     kB  ==  443  .OR.     kB  == 100443 )then
            ! Not defined.
            else
                iflag = 0
            end if
        ! h + pi-
        else if( kB == -211 )then
            ! + pi+/pi0
            if(          kA  ==  211  .OR.     kA  ==  111    )then
            ! + p/pbar/n/nbar
            else if( ABS(kA) ==  2212 .OR. ABS(kA) ==  2112   )then
            ! + Delta+/Deltabar-/Delta0/Deltabar0/Deltabar++/Deltabar+
            else if( ABS(kA) ==  2214 .OR. ABS(kA) ==  2114   &
                .OR.     kA  ==  2224 .OR.     kA  == -1114   )then
            ! + Lambda0/Lambdabar0/Sigma0/Sigmabar0/Sigma+/Sigmabar+
            else if( ABS(kA) ==  3122 .OR. ABS(kA) ==  3212   &
                .OR.     kA  ==  3222 .OR.     kA  == -3112   )then
            ! + Xi-/Xibar+/Xi0/Xibar0
            else if( ABS(kA) ==  3312 .OR. ABS(kA) == 3322   )then
            ! + Omega-/Omegabar+
            else if( ABS(kA) ==  3334 )then
            ! + D+/D-/D*+/D*-/D0/Dbar0/D*0/D*bar0
            else if( ABS(kA) ==  411  .OR. ABS(kA) == 413    &
                .OR. ABS(kA) ==  421  .OR. ABS(kA) == 423    )then
            ! + J/psi / psi'
            else if(     kA  ==  443  .OR.     kA  == 100443 )then
            ! Not defined.
            else
                iflag = 0
            end if

        ! pi0 + h
        else if( kA ==  111 )then
            ! + pi+/pi-/pi0
            if(      ABS(kB) ==  211  .OR.     kB  ==  111    )then
            ! + p/pbar/n/nbar
            else if( ABS(kB) ==  2212 .OR. ABS(kB) ==  2112   )then
            ! + Delta+/Deltabar-/Delta0/Deltabar0/Delta++/Deltabar--/
            !   Delta-/Deltabar+
            else if( ABS(kB) ==  2214 .OR. ABS(kB) ==  2114   &
                .OR. ABS(kB) ==  2224 .OR. ABS(kB) ==  1114   )then
            ! + Lambda0/Lambdabar0/Sigma0/Sigmabar0/Sigma+/Sigmabar-/
            !   Sigma-/Sigmabar+
            else if( ABS(kB) ==  3122 .OR. ABS(kB) ==  3212   &
                .OR. ABS(kB) ==  3222 .OR. ABS(kB) ==  3112   )then
            ! + Xi-/Xibar+/Xi0/Xibar0
            else if( ABS(kB) ==  3312 .OR. ABS(kB) ==  3322   )then
            ! + Omega-/Omegabar+
            else if( ABS(kB) ==  3334 )then
            ! + D+/D-/D*+/D*-/D0/Dbar0/D*0/D*bar0
            else if( ABS(kB) ==  411  .OR. ABS(kB) ==  413    &
                .OR. ABS(kB) ==  421  .OR. ABS(kB) ==  423    )then
            ! + J/psi / psi'
            else if(     kB  ==  443  .OR.     kB  ==  100443 )then
            ! Not defined.
            else
                iflag = 0
            end if
        ! h + pi0
        else if( kB ==  111 )then
            ! + pi+/pi-/pi0
            if(      ABS(kA) ==  211  .OR.     kA  ==  111    )then
            ! + p/pbar/n/nbar
            else if( ABS(kA) ==  2212 .OR. ABS(kA) ==  2112   )then
            ! + Delta+/Deltabar-/Delta0/Deltabar0/Delta++/Deltabar--/
            !   Delta-/Deltabar+
            else if( ABS(kA) ==  2214 .OR. ABS(kA) ==  2114   &
                .OR. ABS(kA) ==  2224 .OR. ABS(kA) ==  1114   )then
            ! + Lambda0/Lambdabar0/Sigma0/Sigmabar0/Sigma+/Sigmabar-/
            !   Sigma-/Sigmabar+
            else if( ABS(kA) ==  3122 .OR. ABS(kA) ==  3212   &
                .OR. ABS(kA) ==  3222 .OR. ABS(kA) ==  3112   )then
            ! + Xi-/Xibar+/Xi0/Xibar0
            else if( ABS(kA) ==  3312 .OR. ABS(kA) ==  3322   )then
            ! + Omega-/Omegabar+
            else if( ABS(kA) ==  3334 )then
            ! + D+/D-/D*+/D*-/D0/Dbar0/D*0/D*bar0
            else if( ABS(kA) ==  411  .OR. ABS(kA) ==  413    &
                .OR. ABS(kA) ==  421  .OR. ABS(kA) ==  423    )then
            ! + J/psi / psi'
            else if(     kA  ==  443  .OR.     kA  ==  100443 )then
            ! Not defined.
            else
                iflag = 0
            end if

        ! K+/K0 + h
        else if( kA ==  321 .OR. kA ==  311 )then
            ! + K-/Kbar0
            if(          kB  == -321  .OR.     kB  == -311    )then
            ! + pbar/nbar
            else if(     kB  == -2212 .OR.     kB  == -2112   )then
            ! + Lambda0/Lambdabar0/Sigma0/Sigmabar0/Sigma+/Sigmabar-/
            !   Sigma-/Sigmabar+
            else if( ABS(kB) ==  3122 .OR. ABS(kB) ==  3212   &
                .OR. ABS(kB) ==  3222 .OR. ABS(kB) ==  3112   )then
            ! + Xi-/Xibar+/Xi0/Xibar0
            else if( ABS(kB) ==  3312 .OR. ABS(kB) ==  3322   )then
            ! + Omega-
            else if(     kB  ==  3334 )then
            ! Not defined.
            else
                iflag = 0
            end if
        ! h + K+/K0
        else if( kB ==  321 .OR. kB ==  311 )then
            ! + K-/Kbar0
            if(          kA  == -321  .OR.     kA  == -311    )then
            ! + pbar/nbar
            else if(     kA  == -2212 .OR.     kA  == -2112   )then
            ! + Lambda0/Lambdabar0/Sigma0/Sigmabar0/Sigma+/Sigmabar-/
            !   Sigma-/Sigmabar+
            else if( ABS(kA) ==  3122 .OR. ABS(kA) ==  3212   &
                .OR. ABS(kA) ==  3222 .OR. ABS(kA) ==  3112   )then
            ! + Xi-/Xibar+/Xi0/Xibar0
            else if( ABS(kA) ==  3312 .OR. ABS(kA) ==  3322   )then
            ! + Omega-
            else if(     kA  ==  3334 )then
            ! Not defined.
            else
                iflag = 0
            end if

        ! K-/Kbar0 + h
        else if( kA == -321 .OR. kA == -311 )then
            ! + K+/K0
            if(          kB  ==  321  .OR.     kB  ==  311    )then
            ! + p/n
            else if(     kB  ==  2212 .OR.     kB  ==  2112   )then
            ! + Lambda0/Lambdabar0/Sigma0/Sigmabar0/Sigma+/Sigmabar-/
            !   Sigma-/Sigmabar+
            else if( ABS(kB) ==  3122 .OR. ABS(kB) ==  3212   &
                .OR. ABS(kB) ==  3222 .OR. ABS(kB) ==  3112   )then
            ! + Xi-/Xibar+/Xi0/Xibar0
            else if( ABS(kB) ==  3312 .OR. ABS(kB) ==  3322   )then
            ! + Omegabar+
            else if(     kB  == -3334 )then
            ! Not defined.
            else
                iflag = 0
            end if
        ! h + K-/Kbar0
        else if( kB == -321 .OR. kB == -311 )then
            ! + K+/K0
            if(          kA  ==  321  .OR.     kA  ==  311    )then
            ! + p/n
            else if(     kA  ==  2212 .OR.     kA  ==  2112   )then
            ! + Lambda0/Lambdabar0/Sigma0/Sigmabar0/Sigma+/Sigmabar-/
            !   Sigma-/Sigmabar+
            else if( ABS(kA) ==  3122 .OR. ABS(kA) ==  3212   &
                .OR. ABS(kA) ==  3222 .OR. ABS(kA) ==  3112   )then
            ! + Xi-/Xibar+/Xi0/Xibar0
            else if( ABS(kA) ==  3312 .OR. ABS(kA) ==  3322   )then
            ! + Omegabar+
            else if(     kA  == -3334 )then
            ! Not defined.
            else
                iflag = 0
            end if

        ! p/n + h
        else if( kA ==  2212 .OR. kA ==  2112 )then
            ! + pi+/pi-/pi0
            if(      ABS(kB) ==  211  .OR.     kB  ==  111    )then
            ! + K-/Kbar0
            else if(     kB  == -321  .OR.     kB  == -311    )then
            ! + p/pbar/n/nbar
            else if( ABS(kB) ==  2212 .OR. ABS(kB) ==  2112   )then
            ! + Delta+/Delta0/Delta-
            else if(     kB  ==  2214 .OR.     kB  ==  2114   &
                .OR.     kB  ==  1114                         )then
            ! + Lambdabar0/Sigmabar0
            else if(     kB  == -3122 .OR.     kB  == -3212   )then
            ! + rho+/rho-/rho0
            else if( ABS(kB) ==  213  .OR.     kB  ==  113    )then
            ! + D+/D-/D*+/D*-/D0/Dbar0/D*0/D*bar0
            else if( ABS(kB) ==  411  .OR. ABS(kB) ==  413    &
                .OR. ABS(kB) ==  421  .OR. ABS(kB) ==  423    )then
            ! + J/psi / psi'
            else if(     kB  ==  443  .OR.     kB  ==  100443 )then
            ! Not defined.
            else
                iflag = 0
            end if
        ! h + p/n
        else if( kB ==  2212 .OR. kB ==  2112 )then
            ! + pi+/pi-/pi0
            if(      ABS(kA) ==  211  .OR.     kA  ==  111    )then
            ! + K-/Kbar0
            else if(     kA  == -321  .OR.     kA  == -311    )then
            ! + p/pbar/n/nbar
            else if( ABS(kA) ==  2212 .OR. ABS(kA) ==  2112   )then
            ! + Delta+/Delta0/Delta-
            else if(     kA  ==  2214 .OR.     kA  ==  2114   &
                .OR.     kA  ==  1114                         )then
            ! + Lambdabar0/Sigmabar0
            else if(     kA  == -3122 .OR.     kA  == -3212   )then
            ! + rho+/rho-/rho0
            else if( ABS(kA) ==  213  .OR.     kA  ==  113    )then
            ! + D+/D-/D*+/D*-/D0/Dbar0/D*0/D*bar0
            else if( ABS(kA) ==  411  .OR. ABS(kA) ==  413    &
                .OR. ABS(kA) ==  421  .OR. ABS(kA) ==  423    )then
            ! + J/psi / psi'
            else if(     kA  ==  443  .OR.     kA  ==  100443 )then
            ! Not defined.
            else
                iflag = 0
            end if

        ! pbar/nbar + h
        else if( kA == -2212 .OR. kA == -2112 )then
            ! + pi+/pi-/pi0
            if(      ABS(kB) ==  211  .OR.     kB  ==  111    )then
            ! + K+/K0
            else if(     kB  ==  321  .OR.     kB  ==  311    )then
            ! + p/pbar/n/nbar
            else if( ABS(kB) ==  2212 .OR. ABS(kB) ==  2112   )then
            ! + Delta+/Delta0/Delta-
            else if(     kB  == -2214 .OR.     kB  == -2114   &
                .OR.     kB  == -1114                         )then
            ! + Lambdabar0/Sigmabar0
            else if(     kB  ==  3122 .OR.     kB  ==  3212   )then
            ! + rho+/rho-/rho0
            else if( ABS(kB) ==  213  .OR.     kB  ==  113    )then
            ! + D+/D-/D*+/D*-/D0/Dbar0/D*0/D*bar0
            else if( ABS(kB) ==  411  .OR. ABS(kB) ==  413    &
                .OR. ABS(kB) ==  421  .OR. ABS(kB) ==  423    )then
            ! + J/psi / psi'
            else if(     kB  ==  443  .OR.     kB  ==  100443 )then
            ! Not defined.
            else
                iflag = 0
            end if
        ! h + pbar/nbar
        else if( kB == -2212 .OR. kB == -2112 )then
            ! + pi+/pi-/pi0
            if(      ABS(kA) ==  211  .OR.     kA  ==  111    )then
            ! + K+/K0
            else if(     kA  ==  321  .OR.     kA  ==  311    )then
            ! + p/pbar/n/nbar
            else if( ABS(kA) ==  2212 .OR. ABS(kA) ==  2112   )then
            ! + Delta+/Delta0/Delta-
            else if(     kA  == -2214 .OR.     kA  == -2114   &
                .OR.     kA  == -1114                         )then
            ! + Lambdabar0/Sigmabar0
            else if(     kA  ==  3122 .OR.     kA  ==  3212   )then
            ! + rho+/rho-/rho0
            else if( ABS(kA) ==  213  .OR.     kA  ==  113    )then
            ! + D+/D-/D*+/D*-/D0/Dbar0/D*0/D*bar0
            else if( ABS(kA) ==  411  .OR. ABS(kA) ==  413    &
                .OR. ABS(kA) ==  421  .OR. ABS(kA) ==  423    )then
            ! + J/psi / psi'
            else if(     kA  ==  443  .OR.     kA  ==  100443 )then
            ! Not defined.
            else
                iflag = 0
            end if

!       rho + h
        else if( ABS(kA) ==  213 .OR. kA ==  113 )then
            ! + p/pbar/n/nbar
            if(      ABS(kB) ==  2212 .OR. ABS(kB) ==  2112   )then
            ! + omega
            else if(     kB  ==  223                          )then
            ! + D+/D-/D*+/D*-/D0/Dbar0/D*0/D*bar0
            else if( ABS(kB) ==  411  .OR. ABS(kB) ==  413    &
                .OR. ABS(kB) ==  421  .OR. ABS(kB) ==  423    )then
            ! + J/psi / psi'
            else if(     kB  ==  443  .OR.     kB  ==  100443 )then
            ! Not defined.
            else
                iflag = 0
            end if
!       h + rho
        else if( ABS(kB) ==  213 .OR. kB ==  113 )then
            ! + p/pbar/n/nbar
            if(      ABS(kA) ==  2212 .OR. ABS(kA) ==  2112   )then
            ! + omega
            else if(     kA  ==  223                          )then
            ! + D+/D-/D*+/D*-/D0/Dbar0/D*0/D*bar0
            else if( ABS(kA) ==  411  .OR. ABS(kA) ==  413    &
                .OR. ABS(kA) ==  421  .OR. ABS(kA) ==  423    )then
            ! + J/psi / psi'
            else if(     kA  ==  443  .OR.     kA  ==  100443 )then
            ! Not defined.
            else
                iflag = 0
            end if

!       K* + h
        else if( ABS(kA) ==  313 .OR. ABS(kA) ==  323 )then
            ! + omega
            if(          kB  ==  223                          )then
            ! Not defined.
            else
                iflag = 0
            end if
!       h + K*
        else if( ABS(kB) ==  313 .OR. ABS(kB) ==  323 )then
            ! + omega
            if(          kA  ==  223                          )then
            ! Not defined.
            else
                iflag = 0
            end if

!       D + h
        else if( ABS(kA) ==  411  .OR. ABS(kA) ==  421  &
            .OR. ABS(kA) ==  413  .OR. ABS(kA) ==  423  )then
                ! + pi+/pi-/pi0
                if(      ABS(kB) ==  211  .OR.     kB  ==  111    )then
                ! + p/pbar/n/nbar
                else if( ABS(kB) ==  2212 .OR. ABS(kB) ==  2112   )then
                ! + rho+/rho-/rho0
                else if( ABS(kB) ==  213  .OR.     kB  ==  113    )then
                ! + D+/D-/D*+/D*-/D0/Dbar0/D*0/D*bar0   !#TODO(Lei20250131)
                ! else if( ABS(kB) ==  411  .OR. ABS(kB) ==  413    &
                !     .OR. ABS(kB) ==  421  .OR. ABS(kB) ==  423    )then
                ! Not defined.
                else
                    iflag = 0
                end if
!       h + D
        else if( ABS(kB) ==  411  .OR. ABS(kB) ==  421  &
            .OR. ABS(kB) ==  413  .OR. ABS(kB) ==  423  )then
                ! + pi+/pi-/pi0
                if(      ABS(kA) ==  211  .OR.     kA  ==  111    )then
                ! + p/pbar/n/nbar
                else if( ABS(kA) ==  2212 .OR. ABS(kA) ==  2112   )then
                ! + rho+/rho-/rho0
                else if( ABS(kA) ==  213  .OR.     kA  ==  113    )then
                ! + D+/D-/D*+/D*-/D0/Dbar0/D*0/D*bar0   !#TODO(Lei20250131)
                ! else if( ABS(kA) ==  411  .OR. ABS(kA) ==  413    &
                !     .OR. ABS(kA) ==  421  .OR. ABS(kA) ==  423    )then
                ! Not defined.
                else
                    iflag = 0
                end if

!       J/psi or psi' + h
        else if( kA ==  443 .OR. kA ==  100443 )then
            ! + pi+/pi-/pi0
            if(      ABS(kB) ==  211  .OR.     kB  ==  111    )then
            ! + K+/K-/K0/Kbar0   !#TODO(Lei20250131)
            ! else if( ABS(kB) ==  321  .OR. ABS(kB) ==  311    )then
            ! + p/pbar/n/nbar
            else if( ABS(kB) ==  2212 .OR. ABS(kB) ==  2112   )then
            ! + rho+/rho-/rho0
            else if( ABS(kB) ==  213  .OR.     kB  ==  113    )then
            ! Not defined.
            else
                iflag = 0
            end if
!       h + J/psi or psi'
        else if( kB ==  443 .OR. kB ==  100443 )then
            ! + pi+/pi-/pi0
            if(      ABS(kA) ==  211  .OR.     kA  ==  111    )then
            ! + K+/K-/K0/Kbar0   !#TODO(Lei20250131)
            ! else if( ABS(kA) ==  321  .OR. ABS(kA) ==  311    )then
            ! + p/pbar/n/nbar
            else if( ABS(kA) ==  2212 .OR. ABS(kA) ==  2112   )then
            ! + rho+/rho-/rho0
            else if( ABS(kA) ==  213  .OR.     kA  ==  113    )then
            ! Not defined.
            else
                iflag = 0
            end if

        ! Not well defined channels.
        else
            iflag = 0
        end if


        return
        end



!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
        subroutine coij_h( ic, jc, i_fail, l_coll, t_coll )
!!      Calculates the collision time of two particles.
        IMPLICIT DOUBLE PRECISION(A-H, O-Z)
        IMPLICIT INTEGER(I-N)
        PARAMETER (KSZJ=300000,NSIZE=750000)
        common/sa1_h/nsa,non1,ksa(kszj,5),psa(kszj,5),vsa(kszj,5)
        common/sa10_h/csnn,cspin,cskn,cspipi,cspsn,cspsm,rcsit,ifram, &
         iabsb,iabsm,i_sigma_AQM,csspn,csspm
        common/ctllist_t/ lc(nsize,6), tc(nsize), tw(nsize)
        common/para_h1/ para(100)
        integer, intent(in) :: ic, jc
        integer :: l_coll(6)
        real(kind=8) :: t_coll
        dimension ri(4), rj(4), ric(4), rjc(4)
        dimension pi(4), pj(4), pic(4), pjc(4), pij(4)
        dimension dr(3), db(3), vi(3), vj(3)
        dimension b(3)


        i_fail = 1
        l_coll = 0
        t_coll = 0D0
        t_max  = para(10)

        pi(4)  = psa(ic,4)
        pj(4)  = psa(jc,4)
        do k1=1,3,1
            pi(k1) = psa(ic,k1)
            pj(k1) = psa(jc,k1)
            b(k1)  = ( pi(k1) + pj(k1) ) / ( pi(4) + pj(4) )
        end do
        pic = pi
        pjc = pj
        pij = pi + pj
!       Invariant mass squared.
        eiej2 = pij(4)**2 - pij(1)**2 - pij(2)**2 - pij(3)**2
!       Inserts the energy cut.
        dm1  = psa(ic,5)
        dm2  = psa(jc,5)
        ecut = SQRT(eiej2) - dm1 - dm2
        if( ecut <= 0D0 ) return
        do n1=1,4,1
            ri(n1) = vsa(ic,n1)
            rj(n1) = vsa(jc,n1)
        end do
        ric = ri
        rjc = rj
        KF1 = ksa(ic,2)
        KF2 = ksa(jc,2)
!       Calculates the interaction distance between particles ic & jc.
        call intdis_h( KF1, KF2, rsig )
        if( rsig <= 0D0 ) return

!       Boosts into the CM frame.
        ! Momentum.
        call lorntz( 0, b, pic, pjc )
        ! Position.
        call lorntz( 0, b, ric, rjc )

!       Finds the minimum distance and the time.
        rb = 0D0
        bb = 0D0
        rtai = 0D0
        do k1=1,3,1
            vi(k1) = pic(k1) / pic(4)
            vj(k1) = pjc(k1) / pjc(4)
        end do
        do k1=1,3,1
            dr(k1) = ric(k1) - rjc(k1) - ( vi(k1)*ric(4) - vj(k1)*rjc(4) )
            db(k1) = vi(k1)  - vj(k1)
            rb = rb + dr(k1)*db(k1)
            bb = db(k1)**2 + bb
        end do
        if( bb <= 1D-10 ) return
        tcol = 0D0 - rb / bb
!       The collision should happen in the future of the CM frame.
        if( tcol < MAX( ric(4), rjc(4) ) ) return
        do ik=1,3,1
            dr(ik) = dr(ik) + tcol * db(ik)
            rtai = rtai + dr(ik) * dr(ik)
        end do
        sg = rtai
        dmin = SQRT(sg)
        if( dmin > rsig ) return
!       Moves along the Newton trajectory in CMS.
        do ik=1,3,1
            ric(ik) = ric(ik) + vi(ik) * ( tcol - ric(4) )
            rjc(ik) = rjc(ik) + vj(ik) * ( tcol - rjc(4) )
        end do
        ric(4) = tcol
        rjc(4) = tcol

!       Transforms back to the Lab frame (causality violation).
        call lorntz( 1, b, ric, rjc )
!       Chooses the min one for the causality violation.
        t_coll = MIN( ric(4), rjc(4) )
!       The collision should happen in the future of the Lab frame.
        if( t_coll < MAX( ri(4), rj(4), 0D0 ) ) return
!       Max time constraint (default 10000 fm/c).
        if( t_coll > t_max ) return

!       Succeeded.
        i_fail = 0

        l_coll(1) = ic
        l_coll(2) = jc
        l_coll(3) = KF1
        l_coll(4) = KF2
        l_coll(5) = 0
        l_coll(6) = 1

!       Determins elastic or inelastic.
        ! rcsit: the cross section ratio of (inela.)/tot.
        ratio = rcsit
        ! Finds the inelastic production.
        if( PYR(1) <= ratio )then
            call coinel( ic, jc, ss, l_coll )
        end if


        return
        end



!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
        subroutine tcolij_h( l, l1, time, icp )
!!      Calculates the collision time & fills up lc(i,1-2), tc(i).
        IMPLICIT DOUBLE PRECISION(A-H, O-Z)
        IMPLICIT INTEGER(I-N)
        PARAMETER (KSZJ=300000,NSIZE=750000)
        common/sa1_h/nsa,non1,ksa(kszj,5),psa(kszj,5),vsa(kszj,5)
        common/sa8_h/tau(kszj),ishp(kszj)
        common/sa10_h/csnn,cspin,cskn,cspipi,cspsn,cspsm,rcsit,ifram, &
         iabsb,iabsm,i_sigma_AQM,csspn,csspm
        common/sa19_h/coor(3)
        common/sa20_h/t0,cspipiKK,dep,ddt,edipi,epin,ecsnn,ekn,ecspsn,ecspsm, &
         rnt,rnp,ecsspn,ecsspm
        common/sa24/adj1(40),nnstop,non24,zstop
        common/ctllist_t/ lc(nsize,6), tc(nsize), tw(nsize)
        common/para_h1/ para(100)
        dimension dr(3),db(3),pi(4),pj(4),vi(3),vj(3)
        dimension ri(4),rj(4),rfi(4),rfj(4),b(3)


        drmax = para(10)
        KF1   = ksa(l,2)
        KF2   = ksa(l1,2)
        pel   = psa(l,4)
        pel1  = psa(l1,4)
        if( pel  < 1D-10 ) pel  = 1D-10
        if( pel1 < 1D-10 ) pel1 = 1D-10
        pi(4) = pel
        pj(4) = pel1
        do i=1,3,1
            pi(i) = psa(l,i)
            pj(i) = psa(l1,i)
            b(i)  = ( pi(i) + pj(i) ) / ( pi(4) + pj(4) )
        end do
        ilo = 0
!       Performs Lorentz transf. to CMS frame.
        call lorntz(ilo,b,pi,pj)
        bta = SQRT( b(1)**2 + b(2)**2 + b(3)**2 )
!       If boost is too violent,put particles on mass shell by hand.
        bmi = PYMASS( KF1 )
        bmj = PYMASS( KF2 )
        if( bta > 0.99999D0 )then
            pi(4) = SQRT( bmi**2 + pi(1)**2 + pi(2)**2 + pi(3)**2 )
            pj(4) = SQRT( bmj**2 + pj(1)**2 + pj(2)**2 + pj(3)**2 )
        end if
        ss = pi(4) + pj(4)
        ! P. Yang
        ecut0 = 0.02D0
        ecut  = ss - bmi - bmj
        if( ecut <= ecut0 ) return
!       if ss < threshold collision may not happen

!       For isothermal forward reactions
!       pipi->KK
        if( (     ( abs(KF1) == 211 .or. KF1 == 111 )   &
            .and. ( abs(KF2) == 211 .or. KF2 == 111 ) ) &
            .and. ss <= 2.*0.5 ) return
!       piN->KY
        if( ( (     abs(KF1) == 211  .or.     KF1  == 111 )    &
            .and. ( abs(KF2) == 2112 .or. abs(KF2) == 2212 ) ) &
            .and. ss <= ( 0.5 + 1.2 ) ) return
        if( ( (     abs(KF2) == 211  .or.     KF2 == 111 )     &
            .and. ( abs(KF1) == 2112 .or. abs(KF1) == 2212 ) ) &
            .and. ss <= ( 0.5 + 1.2 ) ) return
!       piY->K(Cascade)
        if( ( (     abs(KF1) == 211  .or.     KF1  == 111 )    &
            .and. ( abs(KF2) == 3122 .or. abs(KF2) == 3212     &
            .or.        KF2  == 3112 .or.     KF2  == 3222 ) ) &
            .and. ss <= (0.5 + 1.322) ) return
        if( ( (     abs(KF2) == 211  .or.     KF2  == 111 )    &
            .and. ( abs(KF1) == 3122 .or. abs(KF1) == 3212     &
            .or.        KF1  == 3112 .or.     KF1  == 3222 ) ) &
            .and. ss <= (0.5 + 1.322) ) return
!       pi(Cascade)->K(Omega)
        if( ( (     abs(KF1) == 211  .or.     KF1  == 111 )    &
            .and. ( abs(KF2) == 3312 .or. abs(KF2) == 3322 ) ) &
            .and. ss <= (0.5 + 1.7) ) return
        if( ( (     abs(KF2) == 211  .or.     KF2  == 111 )    &
            .and. ( abs(KF1) == 3312 .or. abs(KF1) == 3322 ) ) &
            .and. ss <= (0.5 + 1.7) ) return
!       KN->K(Cascade)
        if( ( (     abs(KF1) == 321  .or. abs(KF1) == 311 )    &
            .and. ( abs(KF2) == 2112 .or. abs(KF2) == 2212 ) ) &
            .and. ss <= (0.5 + 1.322) ) return
        if( ( (     abs(KF2) == 321  .or. abs(KF2) == 311)     &
            .and. ( abs(KF1) == 2112 .or. abs(KF1) == 2212 ) ) &
            .and. ss <= (0.5 + 1.322) ) return
!       piN->pi(Delta)
        if( ( (     abs(KF1) == 211  .or. KF1 == 111 )         &
            .and. ( abs(KF2) == 2112 .or. abs(KF2) == 2212 ) ) &
            .and. ss <= (0.14 + 1.234) ) return
        if( ( (     abs(KF2) == 211  .or. KF2 == 111 )         &
            .and. ( abs(KF1) == 2112 .or. abs(KF1) == 2212 ) ) &
            .and. ss <= (0.14 + 1.234) ) return
!       piN->(rho)N
        if( ( (     abs(KF1) == 211  .or. KF1 == 111 )         &
            .and. ( abs(KF2) == 2112 .or. abs(KF2) == 2212 ) ) &
            .and. ss <= 1.71 ) return
        if( ( (     abs(KF2) == 211  .or. KF2 == 111 )         &
            .and. ( abs(KF1) == 2112 .or. abs(KF1) == 2212 ) ) &
            .and. ss <= 1.71 ) return
!       NN->N(Delta)
        if( ( (     abs(KF1) == 2112  .or. abs(KF1) == 2212 )  &
            .and. ( abs(KF2) == 2112 .or. abs(KF2) == 2212 ) ) &
            .and. ss <= 2.172 ) return
!       K(Cascade)->pi(Omega)
        if( ( (     abs(KF1) == 321  .or. abs(KF1) == 311 )    &
            .and. ( abs(KF2) == 3312 .or. abs(KF2) == 3322 ) ) &
            .and. ss <= 1.84 ) return
        if( ( (     abs(KF2) == 321  .or. abs(KF2) == 311 )    &
            .and. ( abs(KF1) == 3312 .or. abs(KF1) == 3322 ) ) &
            .and. ss <= 1.84 ) return

!       for isothermal reverse reactions
!       piY->KN
        if( ( (     abs(KF1) == 211  .or.     KF1  == 111 )    &
            .and. ( abs(KF2) == 3122 .or. abs(KF2) == 3212     &
            .or.        KF2  == 3112 .or.     KF2  == 3222 ) ) &
            .and. ss <= 1.44 ) return
        if( ( (     abs(KF2) == 211  .or.     KF2  == 111 )    &
            .and. ( abs(KF1) == 3122 .or. abs(KF1) == 3212     &
            .or.        KF1  == 3112 .or.      KF1 == 3222 ) ) &
            .and. ss <= 1.44 ) return
!       pi(Cascade)->KY
        if( ( (     abs(KF1) == 211  .or.     KF1  == 111 )    &
            .and. ( abs(KF2) == 3312 .or. abs(KF2) == 3322 ) ) &
            .and. ss <= 1.7 ) return
        if( ( (     abs(KF2) == 211  .or.     KF2  == 111 )    &
            .and. ( abs(KF1) == 3312 .or. abs(KF1) == 3322 ) ) &
            .and. ss <= 1.7 ) return

        do i=1,4,1
            ri(i) = vsa(l,i)
            rj(i) = vsa(l1,i)
        end do
!       ri(4) = time
!       rj(4) = time
!       Lorentz transf. to CMS frame
        call lorntz(ilo,b,ri,rj)
        rb = 0D0
        bb = 0D0
        rr = 0D0
        rtai = 0D0
        kflag = 0
        do ik=1,3,1
            vi(ik) = pi(ik) / pi(4)
            vj(ik) = pj(ik) / pj(4)
        enddo

        do i=1,3
            rfi(i) = vsa(l,i)  + ( tau(l)  - time ) * ( psa(l,i)  / psa(l,4)  )
            rfj(i) = vsa(l1,i) + ( tau(l1) - time ) * ( psa(l1,i) / psa(l1,4) )
        end do
        rfi(4) = tau(l)
        rfj(4) = tau(l1)
        call lorntz(ilo,b,rfi,rfj)
!       gamli = psa(l,4)  / psa(l,5)
!       gamlj = psa(l1,4) / psa(l1,5)
        ctaui = rfi(4)
        ctauj = rfj(4)
        tcol  = ctaui
        if( ctaui < ctauj ) tcol = ctauj
        do ik=1,3,1
            db(ik) = ( vi(ik) - vj(ik) ) * tcol
            dr(ik) = ri(ik) - rj(ik) - ( vi(ik)*ri(4) - vj(ik)*rj(4) ) + db(ik)
            rtai = rtai + dr(ik)*dr(ik)
        end do
        dott = 0D0
        do ik=1,3,1
            dott = dr(ik) * pi(ik) + dott
        end do

!       dott = -1
!       for the back to back collisions (collision happens in future)
        if( dott >= 0D0 )then
            kflag = 1
            if( tcol <= ri(4) ) return
            if( tcol <= rj(4) ) return
!       for the face to face collisions
        else
            rtai = 0D0
            do ik=1,3,1
                dr(ik) = ri(ik) - rj(ik) - ( vi(ik)*ri(4) - vj(ik)*rj(4) )
                db(ik) = vi(ik) - vj(ik)
                rb = rb + dr(ik)*db(ik)
                bb = bb + db(ik)*db(ik)
                rr = rr + dr(ik)*dr(ik)
            end do
            if( bb  <=  1D-10 ) return
            tcol = 0D0 - rb/bb
!       collision happens in future
            if( tcol <= ri(4) ) return
            if( tcol <= rj(4) ) return
!       collision must be after formation
            if( tcol - ctaui  <=  0D0 ) return
            if( tcol - ctauj  <=  0D0 ) return
!       For collision occurs, time must one step ahead.
            do ik=1,3,1
                dr(ik) = ri(ik)-rj(ik)-(vi(ik)*ri(4)-vj(ik)*rj(4)) + tcol*db(ik)
                rtai = rtai + dr(ik)*dr(ik)
            end do
!           gamai = pi(4) / PYMASS( KF1 )
!           gamaj = pj(4) / PYMASS( KF2 )
!       When collision happens, particles should already be produced.
!       We give a zero formation time for particles produced from rescatttering.
        end if

        sg = rtai
        dmin = sqrt(sg)
        call intdis_h( KF1, KF2, rsig )
!       'intdis': calculate the interaction distance between particles l & l1.
        if( dmin > rsig ) return
!       Distance between the two particles should be smaller than rsig.
        do ik=1,3,1
            ri(ik) = ri(ik) + vi(ik) * ( tcol - ri(4) )
            rj(ik) = rj(ik) + vj(ik) * ( tcol - rj(4) )
        end do
!       Moves along Newton trajectory in CMS.
        ri(4) = tcol
        rj(4) = tcol
        ilo = 1
!       Transforms back to Lab.
        call lorntz(ilo,b,ri,rj)
        tcol1 = ri(4)
        tcol2 = rj(4)
        if( kflag == 0 )then
            if( tcol1 - tau(l)  < 0D0 ) return
            if( tcol2 - tau(l1) < 0D0 ) return
        else
            if( tcol1 - tau(l)  < -1D-4 ) return
            if( tcol2 - tau(l1) < -1D-4 ) return
        end if
        if( ri(4) > rj(4) ) ri(4) = rj(4)
        tcol = ri(4)
        if( tcol <= time ) return
!       Collision happens in the future.
        do i=1,3,1
            ri(i) = vsa(l,i)  + psa(l,i)  * ( tcol - time ) / pel  - coor(i)
            rj(i) = vsa(l1,i) + psa(l1,i) * ( tcol - time ) / pel1 - coor(i)
        end do
        rri = sqrt( ri(1) * ri(1) + ri(2) * ri(2) + ri(3) * ri(3) )
        rrj = sqrt( rj(1) * rj(1) + rj(2) * rj(2) + rj(3) * rj(3) )
!       Particles must be inside the largest region considered.
        if( rri > drmax ) return
        if( rrj > drmax ) return
        if( tcol <= drmax )then
            tc(icp)   = tcol
            lc(icp,1) = l
            lc(icp,2) = l1
        end if


        return
        end



!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
        subroutine intdis_h( KF1, KF2, rsig )
!!      Calculates the interaction distance between two particles.
!!      It plays also the role of second range filter.
        IMPLICIT DOUBLE PRECISION(A-H, O-Z)
        IMPLICIT INTEGER(I-N)
        PARAMETER (KSZJ=300000)
        PARAMETER (pio=3.141592653589793D0)
        common/sa1_h/nsa,non1,ksa(kszj,5),psa(kszj,5),vsa(kszj,5)
        common/sa10_h/csnn,cspin,cskn,cspipi,cspsn,cspsm,rcsit,ifram, &
         iabsb,iabsm,i_sigma_AQM,csspn,csspm
        common/sa20_h/t0,cspipiKK,dep,ddt,edipi,epin,ecsnn,ekn,ecspsn,ecspsm, &
         rnt,rnp,ecsspn,ecsspm
         integer, intent(in) :: KF1, KF2


        rsig = 0D0
        KF1_abs = ABS( KF1 )
        KF2_abs = ABS( KF2 )
        idp1 = 0
        idp2 = 0

!       Uses AQM cross sections.
        rsig = SQRT( sigma_AQM( KF1, KF2, csnn ) / pio )

!       Categorizes the particle 1.
        select case( KF1_abs )
        ! pi
        case( 211, 111 )
            idp1 = 1
        ! K
        case( 321, 311 )
            idp1 = 2
        ! N
        case( 2212, 2112 )
            idp1 = 3
        ! Delta
        case( 1114, 2114, 2214, 2224 )
            idp1 = 4
        ! Lambda, Sigma, Xi, Omega
        case( 3122, 3212, 3112, 3222, 3312, 3322, 3334 )
            idp1 = 5
        ! rho
        case( 213, 113 )
            idp1 = 6
        ! J/psi & psi'
        case( 443, 100443 )
            idp1 = 7
        end select

!       Categorizes the particle 2.
        select case( KF2_abs )
        ! pi
        case( 211, 111 )
            idp2 = 1
        ! K
        case( 321, 311 )
            idp2 = 2
        ! N
        case( 2212, 2112 )
            idp2 = 3
        ! Delta
        case( 1114, 2114, 2214, 2224 )
            idp2 = 4
        ! Lambda, Sigma, Xi, Omega
        case( 3122, 3212, 3112, 3222, 3312, 3322, 3334 )
            idp2 = 5
        ! rho
        case( 213, 113 )
            idp2 = 6
        ! J/psi & psi'
        case( 443, 100443 )
            idp2 = 7
        end select

!       Gets total cross section of 1 + 2.
        select case( idp1 )
        ! pi +
        case(1)
            select case( idp2 )
            ! pi
            case(1)
                rsig = edipi
            ! K
            case(2)
            ! N
            case(3)
                rsig = epin
            ! Delta
            ! Assume the total cross section of (pi)(Delta) = (pi)N.
            case(4)
                rsig = epin
            ! Lambda, Sigma, Xi, Omega
            ! Assume the total x-section of (pi)Y,(pi)Xi, (pi)(Omega) = (pi)N.
            case(5)
                rsig = epin
            ! rho
            case(6)
            ! J/psi and psi'
            case(7)
                rsig = ecspsm
                if( KF2 == 100443 ) rsig = ecsspm
            end select
        ! K +
        case(2)
            select case( idp2 )
            ! pi
            case(1)
            ! K
            ! Assume the total cross section of KK = (pion)(pion).
            case(2)
                rsig = edipi
            ! N
            case(3)
                rsig = ekn
            ! Delta
            case(4)
            ! Lambda, Sigma, Xi, Omega
            ! Assume the total cross section of KY (K Xi) and (K Omega) = KN.
            case(5)
                rsig = ekn
            ! rho
            case(6)
            ! J/psi and psi'
            case(7)
            end select
        ! N +
        case(3)
            select case( idp2 )
            ! pi
            case(1)
                rsig = epin
            ! K
            case(2)
                rsig = ekn
            ! N
            case(3)
                rsig = ecsnn
            ! Delta
            ! Assume the total cross section of N(Delta) = NN.
            case(4)
                rsig = ecsnn
            ! Lambda, Sigma, Xi, Omega
            ! Assume the total cross section of NY, (N Xi), and N(Omega) = NN.
            case(5)
                rsig = ecsnn
            ! rho
            ! Assume the total cross section of (rho)N = (pi)N.
            case(6)
                rsig = epin
            ! J/psi and psi'
            case(7)
                rsig = ecspsn
                if( KF2 == 100443 ) rsig = ecsspn
            end select
        ! Delta +
        case(4)
            select case( idp2 )
            ! pi
            case(1)
                rsig = epin
            ! K
            case(2)
            ! N
            case(3)
                rsig = ecsnn
            ! Delta
            case(4)
            ! Lambda, Sigma, Xi, Omega
            case(5)
            ! rho
            case(6)
            ! J/psi and psi'
            case(7)
            end select
        ! Lambda, Sigma, Xi, Omega +
        case(5)
            select case( idp2 )
            ! pi
            case(1)
                rsig = epin
            ! K
            case(2)
                rsig = ekn
            ! N
            case(3)
                rsig = ecsnn
            ! Delta
            case(4)
            ! Lambda, Sigma, Xi, Omega
            case(5)
            ! rho
            case(6)
            ! J/psi and psi'
            case(7)
            end select
        ! rho +
        case(6)
            select case( idp2 )
            ! pi
            case(1)
            ! K
            case(2)
            ! N
            case(3)
                rsig = epin
            ! Delta
            case(4)
            ! Lambda, Sigma, Xi, Omega
            case(5)
            ! rho
            case(6)
            ! J/psi and psi'
            case(7)
                ! At the case of rho0, the cross section enlarges a factor of 2
                !  to consider the effect of omega.
                rsig = ecspsm
                if( KF1 == 113 ) rsig = ecspsm * SQRT(2D0)
                if( KF2 == 100443 )then
                    rsig = ecsspm
                    if( KF1 == 113 ) rsig = ecsspm * SQRT(2D0)
                end if
            end select
        ! J/psi or psi' +
        case(7)
            select case( idp2 )
            ! pi
            case(1)
                rsig = ecspsm
                if( KF1 == 100443 ) rsig = ecsspm
            ! K
            case(2)
            ! N
            case(3)
                rsig = ecspsn
                if( KF1 == 100443 ) rsig = ecsspn
            ! Delta
            case(4)
            ! Lambda, Sigma, Xi, Omega
            case(5)
            ! rho
            case(6)
                rsig = ecspsm
                if( KF2 == 113 ) rsig = ecspsm * SQRT(2D0)
                if( KF1 == 100443)then
                    rsig = ecsspm
                    if( KF2 == 113 ) rsig = ecsspm * SQRT(2D0)
                end if
            ! J/psi and psi'
            case(7)
            end select
        end select


        return
        end



!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
        subroutine decay(time,deltt)
!!      Deals with particle decay in transport processes.
        IMPLICIT DOUBLE PRECISION(A-H, O-Z)
        IMPLICIT INTEGER(I-N)
        PARAMETER (KSZJ=300000,NSIZE=750000)
        common/sa1_h/nsa,non1,ksa(kszj,5),psa(kszj,5),vsa(kszj,5)
        common/sa8_h/tau(kszj),ishp(kszj)
        common/sa14/ipyth(2000),idec(2000),iwide(2000)
        common/sa17/nde,non17,kde(10,5),pde(10,5),vde(10,5)
        common/sa19_h/coor(3)
        common/ctllist_h/nctl,noinel(2000),nctl0,noel
        common/ctllist_t/ lc(nsize,6), tc(nsize), tw(nsize)
        dimension pp(5),rr(4)
!       idec: stord the line number (in the particle list) of
!        particles after decay
!       iwide: stord the line number (in the particle list) of decaying
!        particles
!       the messages of decayed particles are
!        stored in the varibles and arrays in 'sa17'
!       pp, rr: momentum, position of decaying particle


        nde = 0
        kde = 0
        pde = 0D0
        vde = 0D0
        iwide =0
        ii = 0
        do i=1,nsa,1
            kf = ksa(i,2)
            if( ABS(kf) == 213 .OR. kf == 113 )then
                ii = ii + 1
                iwide(ii) = i
            end if
        end do
        if(ii == 0) return
        do 100 i=1,ii,1
!       deal with decay of decaying particles one by one
        jj = iwide(i)
        kf = ksa(jj,2)
        do i1=1,5,1
            pp(i1) = psa(jj,i1)
        end do
        do i1=1,3,1
            rr(i1) = vsa(jj,i1)
        end do
        rr(4) = time
        ee = pp(4)
        if(ee < 1D-15) ee = 1D-15
        damass = pp(5)
!       compo = damass * 0.151D0 * deltt / 0.197327D0 / ee
        tauj = tau(jj)
        tdel = deltt
        if( (time - deltt) < tauj ) tdel = time - tauj
        compo = damass * 0.151D0 * tdel / 0.197327D0 / ee
        if(compo < 1D-15) compo=1D-15
        prob = 1D0 - EXP( -compo )
!       0.151: full width in [GeV] of decaying particle (rho)
!       mass, full width, energy: in [GeV], time in [GeV^-1] originally
!       0.197327D0: conversion factor from [GeV^-1] to [fm/c]
        if( PYR(1) <= prob )then
!       perform a particle decay
            call decpr(pp,rr,kf)
!       it gives momentum and position to the particles after decay
            call upddep(jj,time)
!       update particle list after a particle decay
            call upddet(time)
!       update collision time list after a particle decay
!           if(nctl == 0)return
        end if
100     continue


        return
        end



!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
        subroutine decpr(pp,rr,kf)
!!      Gives momentum and position to decayed particles.
!       pp, rr: momentum, position of decaying particle
!       kf: flavour code of decaying particle
        IMPLICIT DOUBLE PRECISION(A-H, O-Z)
        IMPLICIT INTEGER(I-N)
        INTEGER PYCOMP
        PARAMETER (KSZJ=300000)
        COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4)
        common/sa8_h/tau(kszj),ishp(kszj)
        common/sa14/ipyth(2000),idec(2000),iwide(2000)
        common/sa17/nde,non17,kde(10,5),pde(10,5),vde(10,5)
        dimension pp(5),rr(4),pi(4),pj(4),rd(3),b(3)


        amas = pp(5)
        amas2 = amas * amas
        nde = 2
!       assume two body decay

        if(kf == 213)then
!       rho+ to pion+ + pion0
            am1 = PMAS( PYCOMP(211), 1 )
            am2 = PMAS( PYCOMP(111), 1 )
            kde(1,2) = 211
            kde(2,2) = 111
        end if
        if(kf == -213)then
!       rho- to pion- + pion0
        am1=PMAS(PYCOMP(-211),1)
        am2=PMAS(PYCOMP(111),1)
        kde(1,2)=-211
        kde(2,2)=111
        endif
        if(kf == 113)then
!       rho0 to pion0 + pion0
        am1=PMAS(PYCOMP(111),1)
        am2=am1
        kde(1,2)=111
        kde(2,2)=111
        endif

        agum=(amas2-(am1+am2)**2)*(amas2-(am1-am2)**2)
        if(agum <= 0.)then
        write(*,*) 'kf,kf1,kf2=',kf,kde(1,2),kde(2,2)
        write(*,*) 'amas,am1,am2=',amas,am1,am2
        agum=1.e-15
        endif

        pab=sqrt(agum)/2./amas
        cita=2.*PYR(1)-1.
        if(cita > 0.9999)cita=0.9999
        sita=sqrt(1.-cita*cita)
        fi=2.*3.1416*PYR(1)
        px=pab*sita*cos(fi)
        py=pab*sita*sin(fi)
        pz=pab*cita
        pi(1)=px
        pi(2)=py
        pi(3)=pz
        pi(4)=sqrt(pab*pab+am1*am1)
        pj(1)=-px
        pj(2)=-py
        pj(3)=-pz
        pj(4)=sqrt(pab*pab+am2*am2)
        ee=pp(4)
        do i=1,3
        b(i)=pp(i)/ee
        enddo
        ilo=1
        call lorntz(ilo,b,pi,pj)
        do i=1,4
        pde(1,i)=pi(i)
        pde(2,i)=pj(i)
        enddo
        pde(1,5)=am1
        pde(2,5)=am2

        rrp=0.8
!       rrp: the radius (in fm) of decaying particle
        do i=1,nde
        cita=2.*PYR(1)-1.
        if(cita > 0.9999)cita=0.9999
        sita=sqrt(1.-cita*cita)
        fi=2.*3.1416*PYR(1)
        rd(1)=rrp*sita*cos(fi)
        rd(2)=rrp*sita*sin(fi)
        rd(3)=rrp*cita
!       arrange the particle i after decay on the surface
!        of sphere with radius rrp and centered at the position of parent
        do j=1,3
        vde(i,j)=rd(j)+rr(j)
        enddo
        vde(i,4)=rr(4)
        enddo


        return
        end



!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
        subroutine upddep(ij,time)
!!      update particle list after a particle decay and
!!       truncate collision list correspondingly.
!       ij: line number (in particle list 'sa1_h') of decaying particle
        IMPLICIT DOUBLE PRECISION(A-H, O-Z)
        IMPLICIT INTEGER(I-N)
        PARAMETER (KSZJ=300000,NSIZE=750000)
        common/sa1_h/nsa,non1,ksa(kszj,5),psa(kszj,5),vsa(kszj,5)
        common/sa8_h/tau(kszj),ishp(kszj)
        common/sa9_h/kfmax,kfaco(100),numb(100)
        common/sa14/ipyth(2000),idec(2000),iwide(2000)
        common/sa17/nde,non17,kde(10,5),pde(10,5),vde(10,5)
        common/sa19_h/coor(3)
        common/sa20_h/t0,cspipiKK,dep,ddt,edipi,epin,ecsnn,ekn,ecspsn,ecspsm, &
         rnt,rnp,ecsspn,ecsspm
        common/ctllist_h/nctl,noinel(2000),nctl0,noel
        common/ctllist_t/ lc(nsize,6), tc(nsize), tw(nsize)
!       idec: stord the order number (in the particle list) of
!        particles after decay


        do m=1,2000
        idec(m)=0
        enddo
!       put decayed particles (in 'sa17') into particle list 'sa1_h'
!        and turncate collision list correspondingly.
        ll=ij
        kd=ksa(ll,2)
        do 500 i=1,nde
        kf=kde(i,2)
        do 600 j=1,kfmax
        if(kf /= kfaco(j)) goto 600
        jj=numb(j)+1
!       update the particle list.
        do m=nsa,jj,-1
        mm=m+1
        ksa(mm,2)=ksa(m,2)
        ksa(mm,1)=1
        ksa(mm,3)=ksa(m,3)
        do m1=1,5
        psa(mm,m1)=psa(m,m1)
        vsa(mm,m1)=vsa(m,m1)
        enddo
        ishp(mm)=ishp(m)
        tau(mm)=tau(m)
        enddo
        if(ll >= jj)ll=ll+1
!       give proper values to particle jj.
        ksa(jj,2)=kf
        ksa(jj,1)=1
        ksa(jj,3)=0
        do m=1,4
        psa(jj,m)=pde(i,m)
        vsa(jj,m)=vde(i,m)
        enddo
        psa(jj,5)=pde(i,5)   ! 220924 Lei
        ishp(jj)=1
        tau(jj)=time
!       the values of 'ishp' and 'tau' of decayed particles
!        are given here, its formation time are assumed to be zero
        do m=j,kfmax
        numb(m)=numb(m)+1
        enddo
        idec(i)=jj
        do m=1,2000
        ipym=idec(m)
        iwi=iwide(m)
        if(ipym > jj)idec(m)=ipym+1
        if(iwi > jj)iwide(m)=iwi+1
        enddo
!       update the values of lc(m,1-2) with value >= jj
        do m=1,nctl
        lc1=lc(m,1)
        if(lc1 >= jj)lc(m,1)=lc1+1
        lc2=lc(m,2)
        if(lc2 >= jj)lc(m,2)=lc2+1
        enddo
        goto 200
600     continue
200     continue
        nsa=nsa+1
500     continue

!       Throws away the colli. pairs with partner of ll.
!        (decaying particle)
        j=0
        do i=1,nctl
        i1=lc(i,1)
        j1=lc(i,2)
        if(i1 == ll) goto 401
        if(j1 == ll) goto 401
        ! 061123 Lei Avoid the particle collideing with itself.
        if(i1 == j1) goto 401
        if((tc(i)-time) <= ddt) goto 401
!       Throws away the pairs with tc <= time.
        j=j+1
        tc(j)=tc(i)
        tw(j)=tw(i)
        do m=1,5
        lc(j,m)=lc(i,m)
        enddo
401     continue
        enddo
        do i=j+1,nctl+1
        tc(i)=0.0
        tw(i)=0.0
        do m=1,5
        lc(i,m)=0
        enddo
        enddo
        nctl=j

!       remove decaying particle (ll) from particle list and
!        truncate the collision list correspondingly.
        kf=ksa(ll,2)
!       kf=kf1
!       ll=l
        if(ll == nsa)then
        kfd=numb(kfmax)-numb(kfmax-1)

!       following statements are added by sa on 07/March/97
        i2 = 0
        if(kfd == 0)then
        numbm=numb(kfmax)
        do i1=1,kfmax
        if(numb(i1) /= numbm) goto 3000
        i2=i1
        goto 3001
3000    enddo
3001    continue
        if(i2 > 0)then
        do i1=i2,kfmax
        numb(i1)=numb(i1)-1
        enddo
        end if
        goto 400
        endif
        numb(kfmax)=numb(kfmax)-1
400     goto 100
        endif
        do j=ll+1,nsa
        jj=j-1
        ksa(jj,2)=ksa(j,2)
        ksa(jj,1)=1
        ksa(jj,3)=ksa(j,3)
        do m=1,5
        psa(jj,m)=psa(j,m)
        vsa(jj,m)=vsa(j,m)
        enddo
        ishp(jj)=ishp(j)
        tau(jj)=tau(j)
        enddo
        do m=1,nctl
        lc1=lc(m,1)
        lc2=lc(m,2)
        if(lc1 > ll)lc(m,1)=lc1-1
        if(lc2 > ll)lc(m,2)=lc2-1
        enddo
        do 800 j=1,kfmax
        if(kf /= kfaco(j)) goto 800
        do m=j,kfmax
        numb(m)=numb(m)-1
        enddo
        goto 100
800     continue
100     continue
        nsa=nsa-1
        do m=1,2000
        ipym=idec(m)
        iwi=iwide(m)
        if(ipym > ll)idec(m)=ipym-1
        if(iwi > ll)iwide(m)=iwi-1
        enddo


        return
        end



!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
        subroutine upddet(time)
!!      Updates collision list after a particle decay.
        IMPLICIT DOUBLE PRECISION(A-H, O-Z)
        IMPLICIT INTEGER(I-N)
        PARAMETER (NSIZE=750000)
        common/sa9_h/kfmax,kfaco(100),numb(100)
        common/sa10_h/csnn,cspin,cskn,cspipi,cspsn,cspsm,rcsit,ifram, &
         iabsb,iabsm,i_sigma_AQM,csspn,csspm
        common/sa14/ipyth(2000),idec(2000),iwide(2000)
        common/sa17/nde,non17,kde(10,5),pde(10,5),vde(10,5)
        common/sa24/adj1(40),nnstop,non24,zstop
        common/ctllist_h/nctl,noinel(2000),nctl0,noel
        common/ctllist_t/ lc(nsize,6), tc(nsize), tw(nsize)
!       idec: store line number (in the particle list) of decayed particles


        dddt = adj1(11)

        nctl=nctl+1
!       loop over particle list

!       Considers channels that are not well defined and treats them as elastic.
        m_upp = numb(kfmax)

        j21 = idec(1)
        j22 = idec(2)
        do j11=1,nde,1
            j1 = idec(j11)
            if( j1 > m_upp ) cycle
            do i=1,m_upp,1
!       decayed particles could not collide with each other immediately
                if(j11 == 1 .and. i == j22) cycle
                if(j11 == 2 .and. i == j21) cycle
!       Avoids the particle collideing with itself.
                if( i == j11 ) cycle
                i1 = i
                call rsfilt_h(j1,i1,iflag)
                if(iflag == 0) cycle
                tc(nctl) = 0D0
                tw(nctl) = 0D0
                call tcolij_h(i1,j1,time,nctl)
!               if( tc(nctl) > 1D-7 ) nctl = nctl + 1
                tci = tc(nctl)
                if(tci > 1D-7)then
                    do jj = 1, nctl-1, 1
                        tcj = tc(jj)
                        if( ABS(tcj - tci) < dddt )then
                            nctl = nctl + 1
                            exit
                        end if
                    end do
                    nctl = nctl + 1
                end if
            end do
        end do
        nctl = nctl - 1


        return
        end



!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
        function sigma_AQM( KF1, KF2, sigma_NN ) result(sigma)
!!      Calculates the hh cross-section via the AQM model. Arbitrary unit.
!       Effective valence quark number:
!           n_eff = n_d + n_u + 0.6*n_s + 0.2*n_c + 0.07*n_b.
!       Cross section of hh collision:
!           sigma_AQM = sigma_NN * n_eff_h1/3 * n_eff_h2/3.
        implicit none
        integer, intent(in) :: KF1, KF2
        real(kind=8), intent(in) :: sigma_NN
        integer :: i, iHadron, KF1Abs, KF2Abs, &
                   i4_KF1, i3_KF1, i2_KF1, i1_KF1, &
                   i4_KF2, i3_KF2, i2_KF2, i1_KF2
        real(kind=8) :: sigma
        integer, dimension(0:9) :: n_q
        real(kind=8), dimension(2) :: n_eff
        real(kind=8), dimension(0:9) :: fract
        data fract / 0D0, 1D0, 1D0, 0.6D0, 0.2D0, 0.07D0, 4*0D0 /


        sigma = 0D0

        ! Decomposes KF code.
        KF1Abs = ABS( KF1 )
        KF2Abs = ABS( KF2 )
        ! KF1
        i4_KF1 =  MOD( KF1Abs/1000, 10 )
        i3_KF1 =  MOD( KF1Abs/100,  10 )
        i2_KF1 =  MOD( KF1Abs/10,   10 )
        i1_KF1 =  MOD( KF1Abs,      10 )
        ! KF2
        i4_KF2 =  MOD( KF2Abs/1000, 10 )
        i3_KF2 =  MOD( KF2Abs/100,  10 )
        i2_KF2 =  MOD( KF2Abs/10,   10 )
        i1_KF2 =  MOD( KF2Abs,      10 )
        iHadron = i3_KF1 * i2_KF1 * i1_KF1 * i3_KF2 * i2_KF2 * i1_KF2
        ! Only hadrons.
        if(      KF1Abs < 100 .OR. KF1Abs >= 9999999 &
            .OR. KF2Abs < 100 .OR. KF2Abs >= 9999999 &
            .OR. iHadron == 0 )then
            write(*,*) "Warning! sigma_AQM: abnormal KF1, KF2:", KF1, KF2
            return
        end if

        n_q = 0
        n_eff = 0D0
        ! Number of valence quarks with different flavors of h1 and h2.
        ! h1
        n_q( i4_KF1 ) = n_q( i4_KF1 ) + 1
        n_q( i3_KF1 ) = n_q( i3_KF1 ) + 1
        n_q( i2_KF1 ) = n_q( i2_KF1 ) + 1
        n_q( i1_KF1 ) = n_q( i1_KF1 ) + 1
        ! Effective valence quark number. Only d, u, s, c, b (1-5).
        do i=1,5,1
            n_eff(1) = n_eff(1) + fract(i)*n_q(i)
        end do
        ! h2
        n_q = 0
        n_q( i4_KF2 ) = n_q( i4_KF2 ) + 1
        n_q( i3_KF2 ) = n_q( i3_KF2 ) + 1
        n_q( i2_KF2 ) = n_q( i2_KF2 ) + 1
        n_q( i1_KF2 ) = n_q( i1_KF2 ) + 1
        ! Effective valence quark number. Only d, u, s, c, b (1-5).
        do i=1,5,1
            n_eff(2) = n_eff(2) + fract(i)*n_q(i)
        end do

!       hh cross section.
        sigma = sigma_NN * n_eff(1)/3D0 * n_eff(2)/3D0


        return
        end



!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
        SUBROUTINE PYCIDATA
!!      Loads some default values for hadronic scatterings.
        IMPLICIT DOUBLE PRECISION(A-H, O-Z)
        IMPLICIT INTEGER(I-N)
        COMMON/PYCIDAT1/KFACOT(100),ISINELT(2000)
        COMMON/PYCIDAT2/KFMAXT,NONCI2,PARAM(100)
        COMMON/SA13/KJP20,NON13,VJP20,VJP21,VJP22,VJP23
        SAVE /PYCIDAT1/,/PYCIDAT2/,/SA13/
!       In order of
!               1            2          3          4            5             6             7             8         9           10
!    0     proton,     neutron,     pbar-,      nbar,         pi+,          pi-,          pi0,           K-,    Kbar0,      Sigma0,
!    1     Sigma-,      Sigma+, Sigmabar0, Sigmabar+,   Sigmabar-,      Lambda0,   Lambdabar0,           K0,       K+,         Xi-,
!    2     Xibar+,         Xi0,    Xibar0,    Omega-,   Omegabar+,       Delta-,       Delta0,       Delta+,  Delta++,        rho+,
!    3       rho-,        rho0,     J/psi,      psi',   Deltabar+,    Deltabar0,    Deltabar-,   Deltabar--,       D+,          D-,
!    4         D0,       Dbar0,       D*+,       D*-,         D*0,       D*0bar,    Lambda_c+, Lambda_cbar-,     D_s+,        D_s-,
!    5      D*_s+,       D*_s-,       K*+,       K*-,         K*0,       K*bar0,      Upsilon,     Upsilon',   chi_0c,      chi_1c,
!    6     chi_2c,    Sigma_c0,  Sigma_c+, Sigma_c++, Sigma_cbar0,  Sigma_cbar+, Sigma_cbar++,        omega,       B0,       B0bar,
!    7         B+,          B-,      B_s0,   B_sbar0,        B_c+,         B_c-,          B*0,       B*bar0,      B*+,         B*-,
!    8      B*_s0,    B*_sbar0,     B*_c+,     B*_c-,   Lambda_b0, Lambda_bbar0,     Sigma_b0,  Sigma_bbar0, Sigma_b-, Sigma_bbar+,
!    9   Sigma_b+, Sigma_bbar-,        8*0
!       (92 particles)
        INTEGER :: KFACOT0(100)
        DATA KFACOT0 / &
!           1      2      3       4      5      6      7       8      9     10
         2212,  2112, -2212,  -2112,   211,  -211,   111,   -321,  -311,  3212, &   ! 10
         3112,  3222, -3212,  -3112, -3222,  3122, -3122,    311,   321,  3312, &   ! 20
        -3312,  3322, -3322,   3334, -3334,  1114,  2114,   2214,  2224,   213, &   ! 30
         -213,   113,   443, 100443, -1114, -2114, -2214,  -2224,   411,  -411, &   ! 40
          421,  -421,   413,   -413,   423,  -423,  4122,  -4122,   431,  -431, &   ! 50
          433,  -433,   323,   -323,   313,  -313,   553, 100553, 10441, 20443, &   ! 60
          445,  4112,  4212,   4222, -4112, -4212, -4222,    223,   511,  -511, &   ! 70
          521,  -521,   531,   -531,   541,  -541,   513,   -513,   523,  -523, &   ! 80
          533,  -533,   543,   -543,  5122, -5122,  5212,  -5212,  5112, -5112, &   ! 90
         5222, -5222,   8*0       /                                                 ! 100
        INTEGER :: ISINELT0(2000)
        DATA ISINELT0 / 2000*1 /
        DATA KFMAXT0 / 92 /
        REAL(KIND=8) :: PARAM0(100)
        DATA PARAM0 /  40D0, 25D0,   21D0,   10D0, 2D0, 0.85D0,  1D0, 0.02D0, &
                      0.1D0,  4D0, 0.16D0, 0.04D0, 6D0,    3D0, 12D0,    6D0, &
                      4*0D0, 80*0D0 /
        DATA KJP020, VJP020,VJP021,VJP022,VJP023 / 1, 0.3D0, 4D0, 1.5D0, 8D0 /


        KFACOT  = KFACOT0
        ISINELT = ISINELT0
        KFMAXT  = KFMAXT0
        PARAM   = PARAM0
        KJP20   = KJP020
        VJP20   = VJP020
        VJP21   = VJP021
        VJP22   = VJP022
        VJP23   = VJP023


        RETURN
        END
!***********************************************************************
!...............   Switches and Parameters from LUCIAE   ...............
! KFACOT: flavor order of considered particles
! ISINELT: switch for i-th inelastic channel
!           =0 closed, =1 opened
! KFMAXT (D=92): KFMAXT kinds of particles are involved in rescattering
! PARAM(1) (D=40.0mb) total cross-section of nucleon-nucleon
! PARAM(2) (D=25.0mb) total cross-section of pi-nucleon
! PARAM(3) (D=21.0mb) total cross-section of K-nucleon
! PARAM(4) (D=10.0mb) total cross-section of pi-pi
! PARAM(5) (D=2.0mb) cross-section of pi+pi --> K+K
! PARAM(6) (D=0.85) ratio of inelastic cross-section to total x-section
! PARAM(7) (D=1.0fm) formation time at rest-frame of particle
! PARAM(8) (D=0.02fm) time accuracy used in hadron cascade
! PARAM(9) (D=0.1) accuracy of four-momentum conservation
! PARAM(10) (D=800000.) size of effective rescattering region (time) is product
!           of PARAM(10) and radius of target, origin is set on (0,0,0)
! PARAM(11) (D=0.16fm^-3) nucleon density of nucleus
! PARAM(12) (D=0.04 GeV^2/c^2) The <Pt^2> for the Gaussian distribution
!            of spectator, not used anymore
! PARAM(13) (D=6.0mb) total cross-section of J/psi + N
! PARAM(14) (D=3.0mb) total cross-section of J/psi + meson
! PARAM(15) (D=12.0mb) total cross-section of psi' + N
! PARAM(16) (D=6.0mb) total cross-section of psi' + meson
!       kjp20 = 0 : energy dependent cross section
!             = 1 : constant cross section
!       vjp20 : constant cross section of strangeness production
!       vjp21 : cross section of pion + p to pion + Delta
!       vjp22 : cross section of pion + p to rho + p
!       vjp23 : cross section of n + n to n + Delta
!***********************************************************************



!ccccccccccccccccccccccccccccccccccccc end ccccccccccccccccccccccccccccccccccccc